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IMPLEMENTING  RECURRENT  BACK-PROPAGATION 
ON  THE  CONNECTION  MACHINE 


1.  INTRODUCTION 

Tlie  recent  resurgence  in  connectionist  modeJs  of  cognition  has  been  spurred  by  exciting  ad¬ 
vances  in  parallel  computing.  As  computational  models  of  cognition,  neural  networks  appear  par¬ 
ticularly  well  suited  to  fine-grained  parallel  processing.  Researchers  exploit  powerful  new  parallel 
processors  to  push  the  bounds  of  size  and  speed  in  their  models.  Indeed,  this  process  must  logi¬ 
cally  lead  to  implementation  of  massively  parallel  networks  in  Very  Large-Scale  Integrated  (VLSI) 
technology. 

The  Connection  Machine  (CM)  provides  a  unique  test-bed  for  the  exploration  of  neural  network 
models  and  their  underlying  graph  architectures.  The  CM  is  a  “Single  Instruction  Multiple  Data” 
(SIMD)  parallel  processor.  It  consists  of  up  to  64K  one-bit  processors  arranged  in  a  16-dimensional 
hypercube  [1].  The  processors  communicate  through  a  flexible  connection  scheme,  allowing  the 
machine  to  be  configured  readily  to  match  the  structure  of  the  problem  [2].  By  spreading  the 
problem  data  over  the  entire  set  of  processors  in  a  proper  manner,  CM  programs  may  exceed  the 
performance  of  conventional  supercomputers  like  the  Cray-2  or  the  ETA-IO. 

Among  the  many  computational  paradigms  for  neural  networks,  recurrent  back-propagation 
(RBP)  presents  unique  advantages  for  parallel  implementations  in  both  software  and  hardware. 
The  algorithm  is  due  to  Pineda  [3,4].  It  treats  a  neural  network  as  a  dynamical  system  where 
the  behavior  of  the  network  obeys  a  system  of  coupled  differential  equations  without  making  any 
distinction  between  input  and  output  nodes.  Thus,  RBP  can  obviously  be  rendered  in  parallel  since 
the  network’s  global  behavior  results  from  homogeneous  nodes  performing  only  local  computations. 

Furthermore,  by  requiring  the  network  to  perform  integrations  where  only  the  steady  state 
solutions  are  of  interest,  the  RBP  may  be  realizable  in  analog,  rather  than  more  complicated 
digital  \TSI  technology.  In  analog  circuitry,  the  network  would  reach  steadystate  asynchronously 
after  the  presentation  of  inputs;  whereas  in  digital  circuitry,  complex  synchronization  would  control 
the  integration  of  the  feed-forward  equations.  Studying  the  behavior  and  implementation  details 
of  this  algorithm  on  the  CM  will  give  insights  to  the  problems  facing  the  designers  of  a  neural 
network  chip 

Tliis  report  presents  two  implementations  of  the  RBP  algorithm  on  the  CM.  The  first  one 
uses  the  grapii  arcliitecture  propo.sed  by  Rosenberg  and  Rleilocb  [5]  for  Aettalk.  In  their  scheme, 
connections  constitute  the  basic  unit  of  representation,  with  most  of  the  processors  in  the  CM 
acting  connections  rather  than  units.  The  results  from  Nettalk  show  that  extremely  large  nets 
may  be  simulated  by  taking  advantage  of  the  unique  routing  and  virtual  processor  features  of  the 
CM  [6.7]. 

.M.incisr:ript  approvofl  SepterTiber  12,  1988. 
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The  scheme  of  Rosenberg  and  Blelloch,  however,  relies  heavily  on  the  sophisticated  routing 
hardware  of  the  CM.  Thus,  another  implementation  was  tried  where  nodes  form  the  basis  of 
representation.  Graph  algorithms  developed  by  Tomboulian  [8,9]  provide  a  method  for  embedding 
and  using  arbitrary  directed  graphs  on  SIMD  machines  much  less  capable  than  the  CM.  Tomboulian 
considers  a  network  architecture  of  exceedingly  simple  processors,  smart  memories,  which  can 
communicate  only  through  connections  to  a  small  set  of  nearest  neighbors.  In  this  regard,  the 
Tomboulian  algorithms  may  provide  a  link  from  a  general  parallel  processor  implementation  to  a 
possible  hardware  implementation  of  RBP.  Having  done  away  with  the  need  for  the  complicated 
routing  hardware  of  the  CM,  one  could  now  think  of  building  a  network  of  smart  memories  coded 
to  act  as  a  neural  net,  all  residing  on  a  single  chip. 

By  comparing  these  two  schemes,  one  is  able  to  draw  conclusions  concerning  the  parallel  imple¬ 
mentation  of  RBP  in  both  software  and  hardware.  The  questions  to  be  examined  are  the  relative 
importance  of  computation  and  communication  and  the  effectiveness  of  net  representations  based 
on  either  connections  or  nodes.  These  questions  of  graph  representation  must  be  answered  if  neural 
networks  are  to  be  realized  successfully  in  VLSI  technology. 

Section  2  reviews  the  RBP  equations  for  both  continuous  mapping  and  associative  memory 
nets.  In  Section  3  the  original  Nettalk  scheme  is  extended  to  the  general  connectivity  nets  of  RBP. 
In  Section  4,  Tomboulian’s  graph  algorithm  is  extended  to  apply  it  as  a  basis  for  communications  in 
RBP  nets.  Section  5  presents  timing  experiments  performed  on  both  implementations,  and  Section 
6  draws  conclusions  concerning  the  effectiveness  of  these  two  schemes  and  their  implications  in 
regard  to  hardware  implementations  of  neural  networks. 


2.  RECURRENT  BACK-PROPAGATION 

In  contrast  with  Rumelhart,  Hinton,  and  Williams  [10]  who  specify  the  6  algorithm  for  discrete, 
feed-forward  networks,  Pineda  [3,4]  treats  neural  networks  as  dynamical  systems,  more  precisely 
as  continuous  dynamical  systems  with  arbitrary  connectivity.  The  behavior  of  these  recurrent 
networks  is  governed  by  systems  of  coupled  differential  equations. 

A  continuous  mapping  net  consists  of  input  units,  hidden  units,  and  output  units.  Input  signals 
are  delivered  to  the  input  units;  the  differential  equations  propagate  the  signals  through  the  net. 
The  purpose  is  to  obtain  the  activation  levels  at  the  output  units. 

For  the  feed-forward  equations,  Pineda  takes  the  differential  system 

=  -Xi  -I-  /(u.)  -I- 

where  /(O  is  flie  logistic  function  (l-|-e“^)“’.  Without  the  nonlinearity  introduced  by  the  logistic 
function,  the  network  could  learn  only  linear  maps.  The  variable  x,  represents  the  activity  of  the 
/til  neuron;  /,  is  the  input  (=  0  if  the  neuron  is  not  an  input  unit).  The  coupling  among  neurons 
is  introduced  at  the  /th  neuron  by  the  term 

u.  =  X! 

] 

Pineda  chooses  the  right-hand  members  so  that  the  solution  tends  to  a  constant  value  x  f  ‘  for  any 
choice  of  the  initial  conditions. 
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The  network  is  trained  to  learn  a  given  mapping  from  a  set  of  input  vectors  (/,)  to  a  set  of  target 
vectors  (T;).  The  weights  (u;,j)  are  adapted  by  least-squares  fit  to  minimize  the  error  function 

i 

where  Ji  is  equal  to  ti  ~  xi  \{  i  is  an  output  unit,  to  0  otherwise.  This  is  done  by  gradient  descent 
on  the  error  function;  thus  the  weights  are  adjusted  in  a  direction  opposite  the  gradient  of  the  error 
function  according  to 

dwij  _  dE 
dt  ^  9wij 

The  learning  rate  t]  must  be  between  0  and  1.  Normally  small  values  for  T)  are  chosen  to  ensure  that 
the  gradient  descent  converges;  nonetheless  it  must  be  said  that  larger  values  of  r]  may  speed  the 
learning.  The  difficulty  resides  in  obtaining  the  partial  derivatives  dEldwij.  Pineda  proposes  to 
do  it  locally  by  defining  a  second  system  of  differential  equations  to  propagate  the  error  corrections 
throughout  the  net. 


In  the  back-propagation  equations, 


dyi 

dt 


=  yi  +  f{ur)iv.  +  J>)^ 


wliere 


and 


I'J/r 


while  Ji  =  t,  —  Xi  if  i  i:.  an  output  unit,  0  otherwise.  Pineda  proves  that  the  gradient  update  is 
such  that 

dwi,j  ^  ^ 

—  =  rixi  y,  , 


yj^  being  the  steady  state  for  the  error  signal  at  the  y'th  unit.  Let  u;"j  be  the  weight  on  the 
connection  between  units  i  and  j  after  n  training  iterations.  To  begin  with,  w^j  is  chosen  at 
random  in  a  small  interval  around  zero.  Then,  is  the  weight  change  specified  by  the  nth 

iteration,  and  the  next  iteration  adopts  for  weights  the  quantities 


w 


n-j- 1 

ij 


n  —  1 


Adding  the  momentum  term  aAu’”J^,  where  a  is  chosen  empirically  between  0  and  1,  was  first 
proposed  by  Rurnelhart,  Hinton,  and  Williams  with  the  suggestion  that  it  damps  out  oscillations 
and  keeps  the  weight  corrections  going  in  one  direction,  thereby  speeding  up  convergence  in  the 
network. 


In  addition  to  continuous  mapping  nets,  associative  memory  nets  will  be  processed  in  the  CM. 
An  associative  memory  net  consists  of  visible  and  hidden  units.  The  input  and  output  of  the 
net  is  read  from  the  activation  levels  of  the  visible  units.  In  this  scheme,  a  master  network  and 
a  slave  network  have  the  same  topology  and  share  the  same  weight  space.  The  master  network, 
obeying  a  constrained  dynamical  system,  is  trained  on  a  set  of  target  vectors  representing  the 
memories  to  be  stored.  The  slave  network  is  not  trained;  it  is  used  to  recall  the  stored  memories. 
Perturbed  versions  of  the  memories  are  presented  to  the  visible  units,  the  slave  network  is  allowed 
to  reach  steady  state,  and  the  original  stored  inputs  are  recovered.  Thus  the  slave  network  has 
the  same  dynamics  as  a  continuous  mapping  net,  and  the  dynamics  of  the  master  network  must 
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be  constrained  to  allow  introduction  of  several  basins  of  attraction  (fixed  points)  into  the  weight 
space. 

The  feed-forward  equations  for  the  master  net  have  the  form 

—  =  -x, +  /{„,), 

where  u;  =  vvith  Zj  constrained  to  be  tj  if  j  is  a  visible  unit,  otherwise  equal  to  the 

activation  level  Xj  if  j  is  a  hidden  unit.  In  accordance  with  this  definition,  the  modified  back- 
propagation  equation  for  the  correction  signal  at  the  ith  unit  becomes 

^  =  -y>  +  +  J,), 

with  Vi  Ylr'^T.iyr-  Tlic  difference  between  the  target  value  and  the  activation  level  J,  is  either 
ti  —  X,  if  i  is  a  visible  unit  or  0  if  i  is  a  hidden  unit.  To  ensure  that  correction  signals  are  received 
only  from  hidden  units  and  not  from  visible  units,  one  introduces  the  factor  1^,7/ ,  which  is  either  0 
if  i  is  a  visible  unit  or  1  if  i  is  a  hidden  unit. 


net: 


Similar  modifications  to  the  continuous  mapping  case  yield  the  gradient  update  in  the  master 

^^i,j  00  00 

IT  =  ’ 


where  and  are  respectively  the  constrained  activation  level  of  the  ith  unit  and  the  correction 
signal  of  the  jth  unit,  both  in  the  steady  state.  Obviously,  the  weight  update  equation  takes  the 
same  form  as  for  the  continuous  mapping  net. 


The  slave  net  in  turn  is  characterized  by  the  unconstrained  dynamical  system 

similar  to  that  of  the  continuous  mapping  net. 

The  same  RDP  routines  serve  for  both  types  of  nets  on  the  CM  since  only  small  modifica¬ 
tions  separate  the  equations  for  the  continuous  mapping  from  those  for  the  associative  memory. 
Admittedly,  the  RBP  algorithm  requires  numerical  integration  of  coupled  systems  of  differential 
equations.  Nevertheless,  these  equations  converge  rapidly;  moreover,  only  their  steady  state  solu¬ 
tions  are  of  interest.  Hence,  however  crude,  the  Euler  method  suffices  to  quickly  solve  feed-forward, 
back-propagation,  and  weight  update  equations. 

The  numerical  integration  depends  critically  on  the  solutions  of  the  differential  equations  con¬ 
verging  rapidly  to  steady-state  solutions.  The  well-behaved  nature  of  these  equations  also  points 
out  the  usefulness  of  RBP  for  VLSI  implementation.  The  feed-forward  and  back-propagation  equa¬ 
tions  could  be  realized  by  analog  circuitry.  Inputs  would  be  presented  to  the  feed-forward  circuits, 
and  the  output  would  be  read  after  the  circuit  reaches  equilibrium  eliminating  the  need  for 
digital  circuitry  to  enforce  timing  constraints. 
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3.  NETTALK  ARCHITECTURE 

As  previously  mentioned,  the  simple  homogeneous  computations  of  the  RBP  algorithm  lend 
themselves  quite  naturally  to  parallel  processing.  Nevertheless,  considering  the  enormous  combi¬ 
natorial  complexity  inherent  to  a  neural  net,  special  attention  must  be  paid  to  the  representation 
of  the  net  inside  the  computer.  This  report  offers  two  representation  schemes.  The  first  is  based 
on  Rosenberg  and  Blelloch's  implementation  of  Nettalk.  Through  their  close  association  with  re¬ 
searchers  at  Thinking  Machines  Corporation,  these  authors  gained  an  intimate  understanding  of 
the  insides  of  the  CM.  As  a  matter  of  fact,  one  cannot  appreciate  the  architecture  for  Nettalk 
without  understanding  pertinent  details  about  communications  and  virtual  processors  as  handled 
b>  a  CM. 

In  the  CM,  processors  communicate  in  several  ways.  The  basic  ones  are  the  router  and  the 
scan  operations.  Through  the  router,  processors  read  from  the  memory  of  any  other  processor 
or  write  into  it.  The  principal  power  of  the  CM  lies  in  the  router;  it  makes  of  the  machine  a 
gigantic  telephone  system  in  which  processors  can  communicate  by  knowing  each  other’s  cube 
address,  tliat  is,  their  phone  number.  This  centrex  becomes  a  computer  thanks  to  the  the  routing 
cycle  that  combines  multiple  values  sent  to  a  single  processor  according  to  various  logical  and 
arithmetic  operations.  The  router,  however,  trades  speed  for  flexibility.  In  problems  where  the 
coiiimuiiications  pattern  is  localized,  the  scan  operations  provide  a  generally  faster  communications 
scheme.  In  scanning,  values  in  contiguous  segments  of  processors  are  easily  copied  or  summed.  In 
general,  the  scan  operations  operate  more  quickly  than  do  the  router  operations. 

Another  important  feature  of  the  CM  is  the  ability  to  use  virtual  processors.  Although  a  full 
CM  contains  only  64K  physical  processors,  each  physical  processor  may  be  multiplexed  into  some 
power  of  two  virtual  processors.  Virtualization  of  the  machine  is  accomplished  in  microcode  and  is 
invisible  to  the  applications  programmer.  Consequently  problems  requiring  more  processors  than 
physically  available  may  still  run  on  the  machine.  An  interesting  side  effect  of  the  virtualization 
is  that  communication  operations  become  more  efficient  for  higher  virtual  processor  (VP)  ratios. 
A  machine  running  a  VP  ratio  of  4  will  probably  execute  code  less  than  4  times  as  slowly;  the 
reason  is  that  more  communication  operations  are  performed  on-chip.  This  increased  efficiency  is 
especially  true  with  scan  operations.  In  particular,  scan  operations  become  very  advantageous  for 
simulating  large  networks  when  the  CM  is  configured  with  high  VP  ratios. 

The  Nettalk  scheme  represents  nets  in  the  CM  with  one  processor  per  unit  and  two  processors 
per  connection.  Each  connection  corresponds  to  a  fan-out  weight  from  its  source  unit  and  a  fan-in 
weight  to  its  destination  unit.  There  is  a  processor  for  the  fan-in  weight  and  another  one  for  the 
fan-out  weight,  and  each  unit  is  preceded  by  its  fan-in  weights  and  followed  by  its  fan-out  weights. 
Proce-ssors  in  a  fan-in/fan-out  pair  are  linked  through  their  processor  addre,ss  so  that  values  may 
be  pass-^d  by  a  global  send  operation.  This  interleaving  of  weights  and  units  allows  one  to  take 
advantage  of  the  very  fast  segmented  scan  operations  provided  by  the  CiM.  Figure  1  shows  the  layout 
of  a  very  simple  or-net  on  the  machine.  The  Nettalk  scheme  as  originally  designed  by  Rosenberg 
and  Blelloch  considered  only  feed-forward,  layered  networks,  but  this  Nettalk  architecture  extends 
naturally  to  the  general  connectivity  nets  treated  by  RBP.  This  extension  is  made  obvious  in  Fig. 
1  where,  at  the  bias  node  e,  one  of  the  fan-out  weights  feeds  back  to  a  fan-in  weight. 

Construction  of  these  nets  may  seem  daunting  at  first  glance,  but  actually  it  is  simple  because 
of  the  powerful  sorting  facilities  on  the  CM.  The  net  is  built  by  first  loading  in  all  fan-in  weights, 
then  loading  the  processors  representing  units,  and  finally  loading  the  fan-out  weights.  Next,  the 
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processors  in  the  net  are  ranked  according  to  the  following  key  —  either  the  unit  address  for  units, 
the  to-unit  address  for  fan-in  weights,  or  the  from-unit  address  for  fan-out  weights.  Tlie  sorting 
operation  in  this  case  is  very  fast  because  the  CM  performs  all  sorts  in  logarithmic  time.  In  tlie 
final  step  of  the  construction  the  units,  fan-in  weights  and  fan-out  weights  are  rearranged  according 
to  the  ranking  produced  by  the  sort.  Figure  2  shows  the  construction  steps  on  the  standard  net 
introduced  in  Fig.  1.  The  reshuffling  involved  in  the  last  step  is  the  most  time-consuming  part 
of  the  construction  operation,  since  many  bits  of  information  must  be  communicated  througli  the 
maciiine  by  a  general  router  cycle.  Nonetheless  the  scheme  allows  extremely  large  nets  to  be 
constructed  in  a  matter  of  seconds. 

An  explanation  of  the  feed-forward  cycle  in  Nettalk  will  serve  to  motivate  the  interleaving 
scheme  of  fan-in  and  fan-out  units.  Although  the  RBP  feed-forward  equation  is  solved,  units  must 
propagate  their  activation  levels  to  all  connected  units.  First,  all  units  “copy-scan”  their  activation 
le\els  to  their  fan-out  weights  for  the  latter  processors  to  form  the  product  W  oX.  With  a  general 
"send"  operation,  the  fan-out  weight  sends  the  result  to  their  corresponding  fan-in  weights.  A 
■  plus-scan"  operation  then  sums  these  activation  values  into  the  units.  Thereafter,  the  next  step 
in  the  numerical  integration  is  performed  locally  in  each  unit.  The  integration  loop  is  repeated 
until  a  steady  state  solution  is  reached.  Figure  3  details  the  cycle  of  copy-scan,  send,  and  plus-scan 
that  is  central  to  the  solution  of  the  feed-forward  equations.  Moreover,  Fig.  4  exhibits  the  *Lisp 
[11]  code  that  implements  the  algorithm.  As  expected,  the  solution  of  the  back-propagation  follows 
a  similar  pattern,  with  correction  signals  being  propagated  backward  from  units  to  their  connected 
units.  The  weight  update  equation  is  solved  in  each  of  the  fan-out  weights,  which  are  designated 
to  hold  the  value  W  for  each  connection. 

The  original  Nettalk  dealt  exclusively  with  layered,  feed-forward  networks.  In  that  elementary 
case,  it  is  possible  to  simultaneously  pipeline  the  activation  levels  forward  and  the  error  signals 
backwards  from  layer  to  layer,  hence  the  phenomenal  throughput  achieved  by  Rosenberg  and 
Blelloch,  Unfortunately,  this  savings  appears  impossible  to  realize  in  the  general  case  of  recurrent 
nets.  It  is  easy  to  understand  why.  The  network  must  reach  equilibrium  for  a  single  input  vector 
before  the  next  one  is  presented;  similarly,  the  error  signals  must  reach  steady  state  for  a  single 
target  vector  before  a  new  one  is  considered.  One  might  also  object  that  it  is  singularly  wasteful 
of  processors  —  two  processors  are  required  for  each  connection.  The  fan-in  weights  and  fan-out 
weights  could  be  collapsed  into  a  single  processor  but  at  the  cost  of  an  extra  routing  step  in  the 
fup,|.f,,r\vqrd  and  ba^'W-nropagation  f-yrles.  In  fact,  performance  requires  spreading  out  the  net 
acro.ss  as  many  processors  as  possible  and  relying  on  the  virtualization  mechanism  to  provide  the 
necessary  resources. 
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Fig.  1  —  Nettalk  architecture  adapted  to  accomodate  the  recurrent  node 
“e”.  The  figure  published  by  Rosenberg  and  Blelloch  has  been  modified  for 
the  recurrent  net. 
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Fig.  2  —  Shuffling  of  processors  after  sorting  on  key 
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Fig.  .3  —  The  feed-forward  cycle  in  a  Ncttalk  architecture.  The  figure  is 
drawn  according  to  tlie  conventions  adopted  by  Rosenberg  and  Blelloch. 


(defun  feed-forward  (net  input!'  ftkey  latched-p) 

(♦all 

( twhen  netp ! ! 

(•when  unitp I ! 

(♦set  I!l  (!!  0.0)  XM  (!!  0.6)  dX!l  (!!  0.5)) 

(♦when  inputp!! 

(if  (meroory-netp  net) 

(♦set  X!!  (the  float-pvar  input!!)) 

(♦set  I!!  (the  float-pvar  input!!)))) 

(♦set  Z! !  X!  !)) 

(♦set  ZM  (scan!!  Z!!  ’copy!!  : segment-pvar  forward-fzm-out-seg ! ! ) ) 

(do  () 

((♦when  unitp!!  (♦and  (<!!  (abs!!  dX!!)  epsilon-x ! ! ) ) ) ) 

(dotiraes  (i  (net-x-iterations  net)) 

(♦when  fan-outp! ! 

(♦set  U! !  (♦ ! !  W! !  Z! ! )) 

(2)  ->  (♦pset  ; no-collisions  U! !  U!!  to-addr!!)) 

(♦when  unitp!!  (♦set  U!  !  (!!  0.0))) 

(3)  ->  (♦set  U!  !  (scan!!  U!!  ’+!!  : segment-pvar  forwaurd-f an-in-seg ! ! ) ) 

(♦when  unitp! ! 

(♦set  LogU! !  (logistic!!  U!!) 

dXI!  (+!!  (♦!!  a!!  (-!!  X!!))  (♦!!  b!!  LogU!!)  I!!) 

X' !  (+! '  X!  !  dX'  !) 

Z!  !  X!  !) 

(if  latched-p 

(♦when  inputp!!  (♦set  Z!!  (the  float-pvar  input!!))))) 

(1)  ->  (♦set  Z!!  (scan!!  Z!!  'copy!!  : segment-pvar  f orward-f an-out-seg ! ! ) ) 

))))) 

I  ig  1  *l,is|)  fiitK  llon  for  the  Ncttalk  feed-forward  ry<  |e.  The  numbered  pointers  liigliliglit  the  form 

reali/.ing  the  three  basic  steps  of  the  cycle. 
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4.  TOMBOULIAN  ARCHITECTURE 


Beside  Nettalk,  another  type  of  graph  architecture  should  be  considered.  The  plan  is  to  compare 
the  respective  advantages  of  these  methods  in  regard  to  their  implementation  on  a  massively  parallel 
processor 

As  does  Nettalk,  Tomboulian  [8,9]  deals  with  directed  graphs.  By  contrast  with  Nettalk,  she 
intends  to  embed  them  in  arbitrary  SIMD  network  architectures,  restricting  herself  to  nearest- 
neighbor  connections  for  communications.  Her  design  makes  assumptions  on  the  graphs  and  on 
the  .SI.MD  hardware.  In  regard  to  the  graphs,  Tomboulian  requires 


•  that  the  graphs  have  a  sparse  set  of  arcs  such  that  the  number  of  arcs  per  vertex  is  much 
smaller  than  the  total  number  of  vertices; 

•  that  the  graphs  be  semidynamic,  with  the  majority  of  edges  remaining  fixed  through  their 
lifetime;  and 

•  that  the  operations  to  be  performed  at  each  vertex  be  homogeneous. 


It  is  evident  that  the  neural  networks  considered  in  this  report  fulfill  the  latter  two  requirements. 
The  first  requirement,  however,  is  not  satisfied  by  neural  nets  with  high  density  of  connections. 

In  regard  to  the  SIMD  architecture,  Tomboulian  specifies  a  very  simple  machine  model. 


•  ihe  processors  execute  a  single  instruction  stream; 

•  processors  have  a  small  amount  of  local  memory; 

•  processors  cannot  access  global  memory  nor  can  they  perform  indirect  addressing; 

•  a  processor  instruction  consists  of  an  op-code  plus  a  local  memory  address; 

•  processors  communicate  only  through  physical  links  to  a  small  subset  of  nearest  neighbors; 

•  each  processor  has  a  unique  identification  number;  and 

•  there  exists  a  data  channel  to  the  front-end  computer. 

Iliis  machine  model  is  definitely  much  simpler  than  the  actual  hardware  and  software  provided 
by  the  f'M.  In  particular  the  router  provides  the  kind  of  global  communications  disallowed  by 
lomboulian.  On  the  other  hand,  grid  addressing  on  the  CM  provides  the  kind  of  local  communica¬ 
tions  to  nearest  neighbors  that  Tomboulian  envisages.  In  grid  addressing,  the  CM  is  configured  as 
ui  .V-dimensional  grid,  where  processors  can  read  from  or  write  to  their  nearest  neighbors  along 

li  dimension.  Ihis  is  the  communications  pattern  referred  to  as  the  NEWS  network.  Currently, 
under  Belease  I,.'!,  the  CM  software  supports  only  two-dimensional  grids.  Release  5  CM  soft- 
a.are.  however,  will  implement  S-D  NEWS,  allowing  experimentation  with  grid  arrays  of  higher 
dimensions. 


To  complete  her  model,  Tomboulian  makes  several  assumptions  on  the  communications  network 
underlying  the  processors. 
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•  The  neighbor  connections  are  full  duplex; 

•  the  labeling  scheme  for  neighbor  links  is  unique  and  consistent  across  all  processors; 

•  there  exists  a  small  number  of  neighbor  links  per  processor; 

•  a  path  of  neighbor  links  exists  between  any  two  processors;  and 

•  the  network  diameter,  that  is,  the  maximum  number  of  hops  between  processors,  is  not  large. 

The  Tomboulian  model  machine  lacks  the  global  routing  mechanism  necessary  for  graph  pro¬ 
cessing;  it  must  be  implemented  in  software.  To  this  effect,  when  embedding  arbitrary  directed 
graphs  on  a  SIMD  machine,  each  vertex  of  the  graph  is  assigned  a  processor.  Then  sending  infor¬ 
mation  along  an  arc  amounts  to  routing  messages  from  neighbor  to  neighbor.  Considering  that  a 
message  may  require  many  hops  to  reach  its  destination,  Tomboulian  defines  the  parallel  traversal 
of  all  arcs  to  be  an  uninterruptible  operation  requiring  T  time  steps;  T  is  what  she  calls  the  time 
quantum.  An  arc  in  the  graph  materializes  as  a  sequence  of  contiguous  links  between  processors, 
beginning  at  a  given  step  in  the  time  quantum.  In  addition,  Tomboulian  forces  paths  to  be  invari¬ 
ant  in  time  and  space,  that  is,  once  the  sequence  of  links  and  the  start  time  for  a  path  are  chosen, 
they  are  never  changed.  No  message  buffering  is  allowed;  once  under  way  a  message  proceeds  from 
link  to  link  without  waiting  at  any  processor.  Finally,  no  message  collisions  are  allowed;  a  processor 
can  receive  only  a  single  message  at  a  given  time  step. 

From  these  specifications,  two  rules  for  path  construction  follow.  First,  only  one  link  can  enter 
and  leave  a  processor  at  any  given  time  step.  Second,  any  path  between  processors  representing  an 
arc  must  consist  of  links  at  contiguous  time  steps.  Given  these  rules,  the  paths  can  be  implemented 
by  a  table  of  T  routing  slots,  as  described  in  Fig.  5.  The  ‘startp’  flag  indicates  the  start  of  an 
arc  whereas  the  ‘endp’  flag  signals  the  end  of  an  arc.  The  ‘arc-label’  field  contains  information 
attached  to  the  start  of  each  arc.  The  ‘forward’  and  ‘backward’  slots  form  the  heart  of  the  routing 
algorithm.  Note  that  Tomboulian  did  not  introduce  a  ‘backward’  slot  since  she  was  interested  only 
in  forward  routing.  The  ‘backward’  slot  must  be  added  to  accommodate  backward  routing  since 
this  feature  is  necessary  in  solving  the  back-propagation  equations  in  a  neural  net. 


struct  .Slot  { 

startp 

boolean  for  start  of  arc 

forward 

forward  read  direction. 

backward 

backward  read  direction. 

endp 

boolean  for  end  of  arc , 

arc-label 

} 

Slots[T] 

information  attached  to  arc. 

Fig.  .'5  -  Routing  t.al)lo  local  to  a  proces.sor  in  the  net 


At  each  time  stej. .  the  processors  examine  the  ‘forward’  or  ‘backward’  slot  to  see  over  which 
neighbor  link  they  must  read  for  forward  or  backward  routing,  respectively.  Hence,  traversing  all 
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arcs  of  the  graph  in  parallel  takes  time  T  as  the  processors  loop  through  their  local  routing  tables. 
Figure  6  presents  an  example  of  a  small  graph  embedded  in  a  grid  of  four  processors.  Figure  7 
summarizes  the  basics  of  the  forward  routing  algorithm;  Fig.  8  contains  the  corresponding  *Lisp 
code. 


Directed  Graph 


Processor  Network 


1 

2 

3  T 

abed 

abed 

abed 

startp 

1111 

0  0  0  1 

0  0  0  0 

forward 
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-  w  ~  ~ 

backward 

E  5  W  N 

~  5  "  N 

E  ^  ~  ~ 

endp 

10  11 

0  0  10 

0  10  0 

Fig.  6  —  The  directed  graph  embedded  in  a  grid  of  four  processors 


Examining  the  basics  of  routing  in  Tomboulian’s  scheme  leads  to  a  discussion  of  its  use  in  solving 
the  feed-forward  equations.  Units  propagate  their  activation  levels  by  forward  routing  along  the 
connectioiis  of  the  net.  On  each  outgoing  connection,  units  send  their  activation  level  multiplied 
by  the  weight  stored  in  that  connection’s  arc-label.  Processors  also  accumulate  the  activation 
messages  received  from  incoming  connections.  Tomboulian’s  forward  routing  cycle  replaces  the 
general  send  and  scan  operations  used  in  the  Nettalk  implementation.  Note  that  the  performance 
of  the  feed-fovvard  equations  depends  critically  on  the  time  quantum  T  that  governs  the  speed  of 
routing  operations. 

In  the  Tomboulian  scheme,  graphs  are  built  serially,  one  arc  at  a  time.  The  first  step  requires 
building  all  possible  trial  paths  from  the  source  processor  to  the  destination.  The  current  *Lisp 
implementation  only  propagates  the  shortest  trial  path  forward  when  several  paths  meet.  Next,  if 
tlie  de.stination  can  be  reached,  pick  the  shortest  trial  path  and  trace  it  backward,  updating  the 
slots  array  along  the  way  (see  Fig.  9). 

This  contrasts  vividly  with  the  Nettalk  construction,  which  performs  a  parallel  construction. 
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Forward  Routing 

for  all  processors  { 

for  time  =  1  to  T  { 

if  slot.startp  =  t 

then  move  msg  to  out-box 

when  slot.forward  free  { 

move  out-box  from  neighbor 
in  slot.forward  to  in-box 


move  in-box  to  out-box 

} 

if  slot.endp  =  t 

then  move  in. box  to  destination 


} 


} 


Fig.  7  —  Tomboulian’s  forward  routing  algorithm  traverses  all  arcs  of 
the  graph  in  time  T. 


Nevertheless,  the  Tomboulian  scheme  does  have  interesting  implications  for  dynamic  configuration 
and  fault  tolerance.  Graph  edges  may  be  deleted  and  added  to  an  existing  graph  easily,  opening 
the  possibility  of  dynamically  reconfiguring  a  neural  net.  Next,  this  dynamic  configuration  offers 
the  possibility  of  fault  tolerance.  Upon  discovering  a  faulty  processor,  all  arcs  going  through 
this  processor  could  be  recovered  and  reconstructed  with  another  processor  assigned  to  the  unit. 
In  short,  although  much  more  expensive,  the  Tomboulian  construction  scheme  exhibits  greater 
flexibility.  Needless  to  say,  dynamic  reconfiguration  of  nets  is  especially  important  for  hardware 
implementations  of  neural  nets.  Indeed  think  of  a  general  neural  net  chip  that  could  be  configured 
for  arbitrary  net  topologies  and  that  could  recover  from  component  failures. 


Experimenting  with  various  SIMD  architectures  by  simulator  and  on  a  CM,  Tomboulian  estab¬ 
lished  empirically  that  the  time  quantum  T  is  approximately  equal  to  the  network  diameter  times 
the  average  degree  of  each  vertex.  In  the  case  of  sparse  graphs,  the  time  quantum  remains  small, 
parallel  traversal  of  the  arcs  proceeds  quickly,  and  the  Tomboulian  scheme  proves  quite  effective. 
■Note  that  Tomboulian  experimented  exclusively  with  graphs  of  low  connectivity  such  as  n-ary  trees 
and  random  graphs  with  few  arcs  per  vertex.  Neural  nets,  however,  exhibit  high  connectivity.  This 
report  assesses  the  dire  results  that  follow  for  the  size  of  the  time  quantum.  As  the  time  quantum 
grows,  so  does  the  time  required  for  routing,  causing  unacceptably  degraded  performance  in  the 
solution  of  the  feed-forward  and  back-propagation  equations. 
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(defmacro  route-lorward  (label-name 

in-box! ! 
in-box-type 
arc-start-function 
arc-end-function) 


(let  ((slot  (gensym)) 

(out-box!!  (gensym))) 

'(let  (.label-name) 

(♦all 

(♦let  (, in-box!! 

.out -box! ! ) 

(declare  (type  , in-box-type 

. in-box ! !  .out -box ! ! ) ) 

(map  nil 

#’ (lambda  (.slot) 

(setf  .label-name 

(slot-2a'c-label! !  .slot)) 

(*if  (slot-startp! !  .slot) 

(♦set  .out -box!! 

.arc-start-function)) 

(♦when  (/=!!  (slot-forward!!  .slot) 
(neighbor-limit ! ! ) ) 

(pref-neighbor! !  .in-box!! 

.out -box! ! 

(slot-forward!!  .slot)) 

(♦set  .out-box!!  .in-box!!)) 
(♦if  (slot-endp!!  .slot) 

. arc-end-function) ) 
slots n  !  !) 

))) 


Fig.  8  —  *Lisp  code  for  forward  routing 


I 
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Shortest  Path  Construction: 

Flood  all  trial  paths  from  source  processor 

If  destination  processor  reached,  then  trace 
shortest  trial  path  backward  &  update  slots 

Shortest  Trial  Path  Flooding: 

for  all  processors  { 
reset  trial-slots 
set  source  processor  active 
for  time  =  1  to  T  { 
when  active  and  free  to  send  { 
for  n  =  1  to  neighbor-limit  { 

if  has  neighbor  n  and  shorter  trial  path  to  n 
then  update  neighbor’s  trial-slot 

} 

} 

if  trial-slot, direction  ^  free 
then  mark  as  active 
if  destination  processor  active  { 
mark  as  inactive 
if  free  to  receive 
then  mark  as  reached 
else  clear  trial-slot 

} 

set  source  processor  active 


Fig.  9  —  Path  con.struction  for  Tomboulian’s  graphs.  The  scheme  at  bottom 
dctaits  the  trial-path  flooding  algorithm. 
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5.  PERFORMANCE 


Before  discussing  the  RBP  algorit*”n’s  performance  on  the  CM,  it  may  prove  reassuring  to 
discuss  how  the  *Lisp  routines  were  verified,  given  the  obvious  difficulties  of  checking  results  in 
massive  networks.  Both  the  Nettalk  and  Tomboulian  implementations  were  exercised  on  several 
small,  well-studied  problems  with  well-known  behavior.  Aj,  ’ndix  A  contains  two  such  toy  prob¬ 
lems.  In  the  first  example,  a  continuous  mapping  net  implemented  with  the  Nettalk  architecture 
successfully  learns  the  inclusive-or  function.  The  second  example  shows  an  associative  memory 
net  implemented  with  the  Tomboulian  scheme  properly  storing  a  target  set  corresponding  to  the 
exclusive-or  function. 

To  assess  the  performance  of  the  RBP  algorithm  on  the  CM,  consider  the  two  network  models 
pictured  in  Fig.  10.  The  continuous  mapping  net  consists  of  N  output  units,  2N  hidden  units,  and 
•TV  input  units,  with  all  layers  fully  connected  to  their  superiors.  Also,  a  bias  node  connects  to  all 
the  units  in  the  hidden  and  output  layers.  For  the  feed-forward  and  back-propagation  equations, 
both  the  input  and  target  vectors  are  taken  to  be  unit  vectors.  The  associative  memory  net  model 
consists  of  a  hidden  layer  of  N  units  and  a  visible  layer  of  8N  units.  The  two  layers  are  linked  by 
bundles  of  connections  where  each  possible  connection  is  made  with  a  probability  of  25%.  For  the 
feed-forward  and  back-propagation  equations,  a  unit  vector  serves  as  the  target. 

Continuous  Mapping  Net 


Associative  Memory  Net 


Fig.  10  —  Neural  net  models  used  in  measuring  the  performance  of  the  RBP 

algorithm  on  the  CM 


The  RBP  timings  were  performed  for  varying  network  model  sizes  N,  for  both  the  Nettalk  and 
Tomboulian  implementations.  In  the  Nettalk  implementation,  the  *Lisp  routines  were  compiled 
with  both  software  and  hardware  floating-point.  For  each  value  of  N ,  we  measured  the  time  to 
construct  the  net  and  to  solve  both  the  feed-forward  and  back- propagation  equations.  Each  such 
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timing  specifies  both  the  total  execution  time  as  measured  on  the  front  end  and  the  actual  execution 
time  on  the  CM. 

Suffice  to  say,  the  timing  experiments  clearly  demonstrate  the  superiority  of  the  Nettalk  ar¬ 
chitecture  over  the  Tomboulian  scheme.  The  Nettalk  implementation  allowed  the  simulation  of 
much  larger  networks.  These  networks  could  be  constructed  much  more  quickly,  and  they  were  far 
more  efficient  in  solving  the  feed-forward  and  back-propagation  equations.  The  Tomboulian  im¬ 
plementation  permitted  only  the  simulation  of  small  nets,  since  the  processor  memory  size  sharply 
limits  the  size  of  the  routing  tables.  Indeed,  for  the  continuous  mapping  net  of  size  N  equals  8, 
the  routing  tables  required  exceed  the  capacity  of  local  processor  memory.  Appendix.  B  provides 
the  complete  set  of  timing  data  collected. 

Instead  of  reciting  numbers,  examining  five  charts  extracted  from  the  timing  data  provides 
clearer  ins'ghl  into  some  characteristics  of  the  CM  and  into  the  performance  of  the  RBP  algorithm. 
Tlie  first  three  charts  illustrate  important  lessons  drawn  from  the  Nettalk  implementation  of  IIBP. 
The  last  two  charts  present  some  trends  exhibited  by  the  Tomboulian  architecture. 

The  secret  of  success  in  the  Nettalk  implementation  lies  in  its  choice  of  connections  as  the  basic- 
unit  of  representation.  Figure  11  plots  the  numbers  of  units,  connections,  and  processors  allocated 
for  increasingly  larger  models  of  the  associative  memory  net.  As  may  be  apparent,  the  number  of 
connections  grows  exponentially  with  the  number  of  units  in  a  neural  network.  The  Nettalk  scheme 
tackles  this  difficulty  head-on  -  the  allocation  curve  for  processor  resources  follows  the  growth  in 
connections,  not  in  units. 


Net  size  parameter  N 


Fig.  11  Allocation  of  processor  resources  for  an  associative  memory  net 
under  the  Nettalk  architecture 


Figure  12  reveals  some  interesting  implications  of  virtualization  on  the  CM.  The  front-end  time 
and  riM  time  required  to  construct  the  continuous  mapping  net  mirror  the  staircase  shape  of  the 
VP  ratio.  With  each  increase  in  the  VP  ratio,  a  physical  processor  must  emulate  larger  numbers 
of  virtual  processors.  Note,  however,  that  the  construction  time  for  larger  mapping  nets  grows 
less  than  linearly  with  the  VP  ratio,  since  sorting  and  communications  operations  become  more 
efficient  for  larger  numbers  of  virtual  processors.  Using  high  VP  ratios  on  the  CM  carries  a  smaller 
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penalty  than  one  might  intuitively  expect. 

The  next  conclusion  concerns  the  relative  importance  of  communications  versus  computation 
in  the  RBP  algorithm.  Figure  13  depicts  the  CM  time  for  solution  of  the  feed-forward  equations 
in  the  continuous  mapping  net  using  software  and  hardware  floating-point.  For  software  floating¬ 
point,  the  CM  processors  perform  all  operations  bit-serially.  For  hardware  floating-point,  the 
feed-forward  routines  take  advantage  of  the  CM’s  WEITEK  floating-point  accelerator  chips.  As 
readily  observed,  the  floating-point  hardware  provides  almost  no  increase  in  performance,  providing 
dramatic  proof  that  the  net  spends  most  of  its  time  in  communications. 

The  RBP  timings  taken  from  the  Tomboulian  architecture  provide  interesting  contrast  to  those 
taken  from  the  Nettalk  scheme.  Figure  14  shows  the  numbers  of  units  and  connections  along  with 
tile  time  quantum  and  percentage  of  routing  slots  used  for  the  associative  memory  net.  As  the  net 
model  size  increases,  the  time  quantum  and  slot  use  grow  linearly  with  the  number  of  units  in  the 
net.  These  results  agree  perfectly  with  Tomboulian ’s  empirical  determination  of  T.  As  the  number 
of  units  increases,  the  average  number  of  connections  per  unit  multiplies,  resulting  in  rapid  growth 
of  the  time  quantum.  Accordingly,  processors  representing  units  consume  burgeoning  amounts  of 
local  memory  space  and  processing  time  to  perform  Tomboulian’s  routing  algorithm. 

The  growth  in  the  time  quantum  holds  dire  consequences  for  network  performance.  Figure  15 
shows  that  the  front  end  and  CM  times  for  a  feed-forward  cycle  in  the  associative  memory  net 
increase  linearly  with  the  time  quantum,  resulting  in  rapid  deterioration  of  RBP  efficiency. 
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Fig.  12  —  Effects  of  CM  virtualization  on  net  construction  efficiency  for  a 
continuous  mapping  net  under  the  Nettalk  architecture 
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Hardware  FP 
Software  FP 


1  4  8  12  16  20  24  28  32  36  40  44  48  52  56  60  64 

Net  size  parameter  N 

Fig.  13  —  Communications  versus  computation  in  the  Nettalk  architecture.  Feed¬ 
forward  cycle  speed  in  a  continuous  mapping  net  is  measured  for  both  hardware 
and  software  floating-point. 


I —  Connections 

—  Units 

—  Slot  Usage 

—  Time  Quantum 


Net  size  parameter  N 


—  Growth  of  the  time  quantum  and  slot  usage  with  net  size  for  an 
associative  memory  net  under  the  Tomboulian  architecture 
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Net  Size  parameter  N 


Fig.  15  —  Decreasing  speed  of  back-propagation  with  growth  of  the  time 
(luantum  for  an  associative  memory  net  under  the  Tomboulian  architecture 


6.  CONCLUSIONS 

As  a  design  tool  assisting  in  the  hardware  realization  of  neural  nets,  the  CM  proves  eminently 
suited  for  simulating  candidate  neural  net  algorithms  and  architectures.  Because  of  its  flexibility, 
the  CM  lends  itself  to  exploring  all  kinds  of  network  architectures  and  communications  patterns. 
The  CM  may  be  used  as  a  universal  parallel  processor  on  which  particular  architectures  may  be 
tested.  In  regard  to  neural  networks,  tlie  CM  plays  the  same  role  traditionally  performed  by  serial 
computers  in  the  hardware  design  process. 

The  CM  simulation  clearly  establishes  that  networks  spend  most  of  their  activity  in  communi¬ 
cating  rather  than  in  calculating.  In  a  serial  implementation,  communication  is  simulated  in  the 
form  of  matrix  operations.  In  the  CM,  on  the  other  hand,  the  communications  are  actual,  not 
simulated:  unit^  send  their  activation  levels  to  connected  units  and,  in  turn,  receive  correction 
signals  from  them.  In  either  case,  these  operations  are  time  consuming.  Therefore,  most  of  the 
resources  of  the  parallel  machine  should  be  spent  on  representing  connections  rather  than  units. 
Tliis  preponderance  of  communication  over  computation  is  especially  true  for  the  RPB  scheme 
since  it  iterates  over  the  net.  In  regard  to  hardware  implementation,  much  attention  has  been  paid 
to  the  problem  of  realizing  arithmetic  operations  in  analog  circuitry.  In  other  words,  researchers 
have  spent  most  of  their  time  implementing  the  units  of  the  net.  Insofar  as  it  reflects  reality,  the 
HBP  simulation  indicates  that  a  far  bigger  problem  lies  in  creating  the  means  for  eflicient  hardware 
communications  —  representing  the  connections  of  the  net. 

Nettalk  works  well  for  highly  connected  nets;  Tomboulian 's  scheme  fails  for  dense  graphs  Tlie 
A'ettalk  implementation,  however,  makes  full  use  of  the  communications  power  of  the  CM.  Such 
sophisticated  routing  capability  seems  impossible  to  realize  on  a  single  chip  in  present  technology. 
A  neural  net  chip  must  be  based  on  simpler  routing  constructs.  For  sparse  nets  with  small  time 
quanta,  the  Tomboulian  architecture  offers  an  alternative,  more  so  because  it  presents  interesting 
implications  for  dynamic  reconfiguration.  Nevertheless,  a  neural  net  chip  still  cannot  be  based  on 
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Tomboulian’s  routing  scheme. 

Ideally,  one  might  conceive  of  combining  the  two  paradigms  to  create  a  neural  net  chip  set. 
On  the  one  hand,  there  would  be  an  analog  chip  containing  collections  of  computing  units  laid  on 
top  of  a  reconfigurable  network  of  wires.  The  feed-forward  and  back-propagation  equations  would 
be  solved  by  analog  computations  according  to  Pineda’s  RBP  algorithm.  This  chip  resembles 
the  Nettalk  architecture  in  that  most  of  the  hardware  resources  would  be  devoted  to  a  flexible 
network  of  connections  among  the  units.  On  the  other  hand,  there  would  a  digital  controller  chip 
to  configure  the  communications  network  on  the  analog  chip  by  running  a  path-finding  algorithm, 
such  as  Tomboulian’s.  Such  a  pairing  would  allow  the  general  analog  chip  to  actuate  arbitrary 
neural  net  topologies,  and  provide  a  measure  of  fault  tolerance  by  dynamic  reconfiguration. 


7.  ACKNOWLEDGMENTS 


Dr.  Fernando  Pineda  of  the  Applied  Physics  Lnooratory  (Johns  Hopkins  University)  suggested 
the  topic  of  this  work  and  reviewed  the  results.  Without  the  support  of  Dr.  Shannon  Coffey  at  the 
Navy  Center  for  Space  Technology  (Naval  Research  Laboratory),  this  research  would  not  have  been 
possible.  Robert  Whaley  of  Thinking  Machines  Corporation  has  been  of  considerable  assistance  in 
the  coding  and  the  use  of  the  Connection  Machine.  Comments  by  Dr.  Liam  Healy,  NRC  Research 
Associate  at  the  Naval  Research  Laboratory,  and  by  Dr.  Andre  Deprit  of  the  Center  for  Applied 
Mathematics  (National  Bureau  of  Standards)  have  been  very  helpful. 


8.  REFERENCES 

1.  W.  D.  Ilillis,  The  Connection  Machine  (The  MIT  Press,  Cambridge,  MA,  1985). 

2.  W.  D.  Hillis  and  G.  L.  Steele,  Jr.,  “Data  Parallel  Algorithms,”  Commun.  ACM  29,  1170-1183 
(1986), 

3.  F.  J.  Pineda,  “Generalization  of  Back-Propagation  to  Recurrent  Neural  Networks,”  Phys.  Rev. 
Lett.  59,  2229-2232  (1987), 

4.  F.  J.  Pineda.  “Generalization  of  Back-Propagation  to  Recurrent  and  Higher  Order  Neural- 
Networks,”  to  appear  in  the  Proceedings  of  IEEE  Conference  on  Neural  Information  Processing 
Systems,  Denver,  CO  (1987). 

5.  C.  R.  Rosenberg  and  G.  E.  Blelloch,  “An  Implementation  of  Network  Learning  on  the  Con¬ 
nection  Machine,”  Technical  report.  Thinking  Machines  Corporation,  Cambridge,  MA,  1986. 

G.  Connection  Machine  Parallel  Instruction  Set  (Thinking  Machines  Corporation,  Cambridge, 
MA,  1986). 

7.  Introduction  to  Data  Level  Parallelism  (Thinking  Machines  Corporation,  Cambridge,  MA, 
1986). 

8.  S.  J.  Tomboulian,  A  System  for  Routing  Arbitrary  Communication  Graphs  on  SIMD  Archi¬ 
tectures,  Ph.  D.  Dissertation,  Duke  University,  1986. 


20 


NRL  REPORT  9167 


9.  S.  J.  Tomboulian.  “A  Brief  Overview  of  a  System  for  Routing  Directed  Graphs  on  SIMD 
Architectures,”  to  appear  in  the  Proceedings  of  2nd  Symposium  on  the  Frontiers  of  Massively 
Parallel  Computation,  Fairfax,  VA  (1988). 

10.  D.  E.  Rumelhart,  G.  E.  Hinton,  and  R.  J.  Williams,  in  Parallel  Distributed  Process¬ 
ing,  D.  E.  Rumelhart  and  J.L.  McClelland,  eds.  (The  MIT  Press,  Cambridge,  MA,  1986). 

11.  *Ltsp  Reference  Manual  (Thinking  Machines  Corporation,  Cambridge,  MA,  1987). 


21 


Appendix  A 
SAMPLE  NETS 


As  explained  in  Section  5,  several  elementary  problems  serve  to  verify  the  implementation  ol 
RBP  on  the  CM.  These  sample  runs  also  prove  useful  in  demonstrating  how  to  use  the  *Lis|i 
routines. 


A1  Nettalk  Architecture 


The  first  sample  run  teaches  the  net  depicted  in  Fig.  A1  the  inclusive-or  function. 


Output 


Fig.  At  —  Iiiclusive-or  continuous  mapping  net  constructed  by  tlie 
DEF-MAPPING-NET  macro 

ihe  following  forms  typed  to  the  Lisp  listener  construct  the  lOIl  net,  define  and  load  the  ni- 
put/target  pairs,  and  start  the  training. 


(def-mapping-net  or-mapping-net 

;8lab8  ’(2  1  1  1) 

: input-8lab-no  0 
: output-8lab-no  2 
:bundle8  ’((1  0  100) 
(2  0  100) 
(2  1  100) 
(1  3  100) 
(2  3  100) 
(3  3  100) 
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) 

) 

(defvcLr  *ior-Bapping-pairs*) 

(setf  ‘ior-niapping-pairs* 

(list-to-array-pairs  ’(((0.0  0.0)  (0.0)) 

((0.0  1.0)  (1.0)) 

((1.0  0.0)  (1.0)) 

((1.0  1.0)  (1.0))))) 

(defvar  ♦icr-mapping-set*) 

(setf  *ior-mapping-3et* 

(cm-load-mapping-set  ’ior-mapping-set  ♦ior-napping-pairs*)) 

(train-net  or-mapping-net 

* i or-mapping-set  * 

:print-training-set  # ’print-training-set 
: print-interval  20 
;print-net-io  #’print-io-vecs) 


1  lie  report  produced  by  the  IRAIN-NET  function  is  excerpted  below  and  summarized  in  Tabl 


Net  Training 

CONTINUOUS-MAPPING  net:  OR-MAPPING-HET 

4  slabs,  6  bundles 

5  units,  8  connections  ->21  processors 
a  =  1.0,  b  =  1.0 

Feed-forvard  convergence  «  0.001,  min  4  iterations 
Back-propagate  convergence  =  0.001,  nin  4  iterations 


eta  =  0.25,  alpha  =  0.9 

Weight  update  convergence  “0.1,  max  10000  iterations 


MAPPING-SET:  IOR-MAPPING-SET 


i  : 

0.0 

0.0 

t: 

0.0 

i  : 

0.0 

1.0 

t: 

1.0 

i : 

1.0 

0.0 

t: 

1.0 

i : 

1.0 

1.0 

t; 

1.0 

Iteration  0 

i ; 

0.0 

0.0 

0 : 

0.47596744 

i  : 

0.0 

1.0 

0 : 

0.49091664 

i : 

1.0 

0.0 

o : 

0.4085974 

i  : 

1.0 

1.0 

o : 

0.42314819 

Error  =  2.1533053 


Iteration  20 


i : 

0.0 

0.0 

0 : 

0.60783666 

X : 

0.0 

1.0 

o : 

0.7946026 

i  : 

1.0 

0.0 

o : 

0.77972716 

i  : 

1.0 

1 .0 

o : 

0.89824456 

Error  =■  1.1352623 
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Iteration  300 


i : 

0.0 

0.0 

o : 

0.0999451 

i : 

0.0 

1.0 

0 : 

0.9384478 

i : 

1.0 

0.0 

0 : 

0.93790066 

i : 

1.0 

1.0 

o : 

0.9991285 

Error  =  0.22446814 


Training  set  learned  after  301  iterations. 


i : 

0.0 

0.0 

o : 

0.09965193 

i : 

0.0 

1.0 

0 : 

0.9386314 

i : 

1.0 

0.0 

o : 

0.93808526 

i : 

1.0 

1.0 

0 : 

0.99913496 

Error  =  0.22446814 


Table  Al  —  Sample  Run  for  tlic  Ncttalk  Implementation  of  an  lOR  Mapping  .N'et 


Iteration 

Input  — >• 

Output 

Error 

[0.0]  [0] 

[0-1]  -*  [1] 

[1,0]  ^  [1] 

[1.1]  -[1] 

0 

0.4759G7440 

0.49091664 

0.40859740 

0.42314819 

2.15330530 

20 

0.607836C60 

0.79460260 

0.77972716 

0.89824456 

1.13526230 

40 

0.. 523044400 

0.78751314 

0.78820790 

0.92609406 

1.02122930 

GO 

0.445310150 

0.79706100 

0.80016330 

0.95087760 

0.89720820 

80 

0.374926000 

0.81468093 

0,81675434 

0.96944827 

0.77404240 

100 

0.312892900 

0.83.520794 

0,83605444 

0.98171127 

0.65991926 

120 

0.261516780 

0.85550890 

0.85557880 

0.98894240 

0.56148670 

140 

0.221299750 

0.87,344560 

0,87311420 

0.9''305516 

0.48168480 

160 

0.190724300 

0.88835150 

0.88783570 

0.99538165 

0.41915548 

180 

0.167220180 

0.90026370 

0,89967410 

0.99674326 

0.37053907 

200 

0.149121730 

0.91006210 

0.90944266 

0.99759334 

0.33202365 

220 

0.134924490 

0.91799843 

0.91737980 

0.99814450 

0.3014017.3 

240 

0.1235.31714 

0.92450523  ' 

0.92390060 

0.99851924 

0.27660662 

260 

0.1 14199980 

0,92991730 

0.92933120 

0.99878496 

0,25616658 

280 

0.106417686 

0.9.3448216 

0.93391600 

0.99898010 

0.23903945 

.300 

0.099945100 

0.93844780 

0.93790066 

0.99912850 

0.22446814 

301 

0.099651930 

0.93863140 

0.93808526 

0.99913496 

0.22446814 
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A2  Tomboulian  Architecture 

This  section  parallels  the  results  of  the  previous  one  for  an  exclusive-or  associative  memory  net 
underlied  by  the  Tomboulian  architecture.  The  Lisp  forms  below  construct  and  train  the  exclusive- 
or  net  specified  in  Fig.  A2.  Table  A2  summarizes  the  sample  run  presented. 


SlabO 


Slab  0 


Fig.  A2  —  Exclusive-or  associative  memory  net  constructed  by  the 
DEF-MEMORY-NET  macro 

The  following  forms  typed  to  the  Lisp  listener  construct  the  XOR  net,  define  and  load  the  target 
vectors,  and  start  the  training. 


(def-memory-net  or-aemory-net 
:slabs  ’(3  1) 

: input-slab-no  0 
:bundles  ’((00  100) 

(0  1  100) 

(1  1  100) 

) 

:epsilon-w  0.05 

) 

(defvar  ♦xor-memory-list*) 

(self  ♦lor-memory-list* 

(list-to-axxay  ’((0.0  0.0  0.0) 

(0.0  1.0  1.0) 

(1.0  0.0  1.0) 

(1.0  1.0  0.0)))) 

(defvar  ♦xor-memory-set*) 

(setf  *xor-memory-set» 

(cm-load-meaory-set  ’xor-memory-set  *xor-meBory-li3t*) ) 

(train-net  or-memory-net 
♦xor-memory-set* 

:print-training-set  # ’print-training-set 
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: print-interval  20 
; print -net-io  # ’print-io-vecs) 


The  TRAIN-NET  function  produces  the  reported  excerpted  below;  Table  A2  documents  the  com¬ 
plete  training  results. 


Net  Training 

ASSOCIATIVE -MEMORY  net:  OR-MEMORY-NET 
2  slabs,  3  bundles 

4  units,  13  connections  ->4  processors 
a  =  1.0,  b  =  1.0 


Feed-forward  convergence  »  0.001,  min  4  iterations 
Back-propagate  convergence  =  0.001,  min  4  iterations 


eta  =  0.25,  alpha  =  0.9 

Weight  update  convergence  =  0.05,  max  10000  iterations 

MEMORY-SET:  XOR-MEMQRY-SET 
i:  0.0  0.0  0.0 
i:  0.0  1.0  1.0 
i:  1.0  0.0  1.0 
i:  1.0  1.0  0.0 


Iteration  0 
i:  0.0  0.0  0.0 

o: 

0.53553134  0.55844945  0.5587541 

i:  0.0  1.0  1.0 

o: 

0.66410667  0.5466608  0.5988787 

i:  1.0  0.0  1.0 

0 : 

0.66019136  0.57686245  0.5815371 

i;  1.0  1.0  0.0 

o: 

0.6112226  0.58896685  0.47078228 

Error  =  3.3785267 

Iteration  20 

i:  0.0  0.0  0.0 

o : 

0.39624417 

0.42216888  0.42507586 

i:  0.0  1.0  1.0 

0 : 

0.20121947 

0.82004374  0.83080995 

i:  1.0  0.0  1.0 

0 : 

0.82579315 

0.19658758  0.82820785 

i:  1.0  1.0  0.0 

0 : 

0.81852823 

0.8260062  0.18509121 

Error  =  1.6629202 

Iteration  420 


i : 

0.0 

0.0 

0.0 

0 : 

0.050692994  0.051062807  0.05110865 

i : 

0.0 

1.0 

1.0 

0 : 

0.03370365  0.9651646  0.96524113 

i : 

1.0 

0.0 

1.0 

0 : 

0.96526337  0.03356958  0.9652226 

i : 

1.0 

1.0 

0.0 

o : 

0.9652148  0.9652037  0.03343686 

Error  = 

=  0.2669139 

Training  set  learned  after  438  iterations. 

i:  0.0  0.0  0.0  o:  0.07672652  0.07758254  0.07768838 
i:  0.0  1.0  1.0  o:  0.044398107  0.95486647  0.9549862 
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i:  1.0  0.0  1.0  o;  0.95502245  0.04418476  0.9549585 

i:  1.0  1.0  0.0  o:  0.95495033  0.95493317  0.043976907 

Error  =  0.2611845 


Table  A2  —  Sample  Run  for  the  Tomboulian  Implementation  of  an  XOR  Memory  Net 


Iteration 

Fixed  Points 

Error 

[0,0,0] 

[0,1,1] 

[1,0,1] 

[1,1,0] 

0 

0.535531340 

0.664106670 

0.660191360 

0.611222600 

3.378526700 

0.558449450 

0.546660800 

0.576862450 

0.588966850 

0.558754100 

0.598878700 

0.598878700 

0.470782280 

20 

0.396244170 

0.201219470 

0.825793150 

0.818528230 

1.662920200 

0.422168880 

0.820043740 

0.196587580 

0.826006200 

0.425075860 

0.830809950 

0.828207850 

0.185091210 

40 

0.275940400 

0.120262250 

0.868772030 

0.866055200 

1.160470500 

0.292070450 

0.865704660 

0.118025504 

0.867952100 

0.293652100 

0.869275100 

0.868246800 

0.113853940 

80 

0.149614990 

0.077436500 

0.908097900 

0.907281640 

0.720232400 

0.155146170 

0.906636600 

0.076124990 

0.907307000 

0.155658470 

0.907629300 

0.907315900 

0.074514830 

120 

0.110390110 

0.063607864 

0.928866000 

0.928474600 

0.551653400 

0.113153750 

0.928096300 

0.062789350 

0.928415240 

0.113438090 

0.928O.4100 

0.928464100 

0.061894290 

160 

0.090866710 

0.055146575 

0.940168600 

0.939931000 

0.462379520 

0.092580350 

0.939691840 

0.054593630 

0.939884660 

0.092768740 

0.940025030 

0.939934250 

0.054013073 

200 

0.078779950 

0.049278720 

0.947459400 

0.947296400 

0.405272000 

0.079972155 

0.947130500 

0.048876950 

0.947262400 

0.080108650 

0.947367670 

0.947305300 

0.048463512 

240 

0.070399430 

0.044914193 

0.952646800 

0.952526300 

0.364817650 

0.071289600 

0.952403200 

0.044606360 

0.952500460 

0.071394210 

0.952582900 

0.952536940 

0.044293456 

280 

0.064166170 

0.041510116 

0.956574500 

0.956481100 

0.334269300 

0.064863300 

0.956385100 

0.041264930 

0.956460540 

0.064946750 

0.956527200 

0.956491530 

0.041017827 

320 

0.059303710 

0.038762380 

0.959679250 

0.959604000 

0.310167850 

0.059868710 

0.959526800 

0.038561273 

0.959587300 

0.059937287 

0.959642600 

0.959613860 

0.038359870 

360 

0.055377590 

0.036485903 

0.962211900 

0.962149700 

0.290535570 

0.055847496 

0.962085840 

0.036317125 

0.962135800 

0.055905145 

0.962182500 

0.962158800 

0.036149006 

400 

0.052123690 

0.034560820 

0.964328050 

0.964275540 

0.274150460 

0.052522577 

0.964221400 

0.034416642 

0.964263600 

0.052571874 

0.964303900 

0.964283900 

0.034273600 

438 

0.076726520 

0.044398107 

0.955022450 

0.954950330 

0.261184500 

0.077582540 

0.954866470 

0.044184760 

0.954933170 

0.077688380 

0.954986200 

0.954958500 

0.043976907 
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Appendix  B 
TIMINGS 


To  evaluate  the  performance  of  the  RBP  algorithm  on  the  CM,  the  following  tables  present  the 
timing  data  collected  for  the  neural  net  models  of  Fig.  10. 

Tables  B1  to  B4  present  statistics  for  the  continuous  mapping  and  associative  menioiy  net 
models  under  the  Nettalk  architecture.  The  following  data  are  given  for  each  value  of  the  net  .size 
parameter  N: 

the  number  of  units  in  the  timing  net, 
the  number  of  connections, 
the  number  of  virtual  processors  used, 
the  ratio  of  virtual  to  physical  processors. 

The  next  columns  give  the  time  taken  to  perform  the  three  basic  operations: 

making  the  net, 
feed-forward  cycle, 
back-propagation  cycle. 

Each  timing  is  given  both  as  the  total  elapsed  time  on  the  front  end  and  on  the  CM. 

Table  B2  provides  the  same  timings  as  Table  Bl.  In  contrast  to  Table  Bl,  however,  the  timings 
in  Table  B2  were  collected  by  using  software  rather  than  hardware  floating-point  in  an  attempt  to 
a.ssess  the  dominance  of  communication  over  computation  in  the  nets. 

The  same  relationship  exists  between  Tables  B3  and  B4  for  an  associative  memory  net  in  the 
.Nettalk  implementation.  Tables  B3  and  B4  provide  timing  data  for  associative  memory  nets  rather 
than  continuous  mapping  nets  in  order  to  verify  the  modifications  required  to  the  RBP  algorithm 
and  assess  its  performance  on  lower  density  nets. 

Tables  B5  and  B6  give  timing  data  for  continuous  mapping  and  associative  memory  nets  by 
using  the  Tomboulian  architecture.  Two  columns  have  been  added:  one  for  the  time  quantum  and 
one  for  the  slot  use  in  the  routing  tables.  The  results  in  these  tables  provide  a  vivid  contrast  to 
those  in  Tables  Bl  to  B4,  thereby  revealing  the  superiority  of  the  Nettalk  scheme. 
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Table  Bl  —  Timings  for  the  Nettalk  Implementation  of  a  Continuous  Mapping  Net 
Compiled  with  Hardware  Floating  Point 


N 

Units 

Connections 

Processors 

VP 

Make  (s) 

FF  (s) 

BP  (s) 

Ratio 

CM 

Total 

CM 

Total 

CM 

Total 

1 

8 

18 

44 

1 

n 

4 

29 

237 

503 

1 

0.210 

0.320 

8 

57 

921 

1899 

1 

0.468 

0.580 

0.027 

0.030 

12 

85 

2053 

4191 

1 

0.892 

1.010 

0.076 

0.160 

16 

113 

3633 

7379 

1 

1.467 

1.580 

0.078 

0.160 

0.028 

0.030 

20 

141 

5661 

11463 

■ 

2.304 

3.390 

0.092 

0.160 

0.038 

0.040 

24 

169 

8137 

16443 

D 

3.585 

9.600 

0.146 

0.200 

0.078 

0.080 

28 

197 

11061 

22319 

■ 

4.642 

7.680 

0.155 

0.210 

0.078 

0.080 

32 

225 

14433 

29091 

D 

5.879 

10.900 

0.165 

0.220 

0.154 

0.160 

36 

253 

18253 

36759 

8 

8.663 

21.410 

0.281 

3.300 

0.163 

4.090 

40 

281 

22521 

45323 

8 

10.469 

23.170 

0.295 

4.300 

0.176 

4.090 

44 

309 

27237 

54783 

8 

12.076 

23.770 

0.293 

4.300 

0.173 

4.100 

48 

337 

32401 

65139 

8 

13.796 

24.610 

0.292 

4.300 

0.183 

4.090 

52 

365 

38013 

76391 

16 

21.192 

36.930 

0.583 

8.400 

0.359 

4.090 

56 

393 

44073 

88539 

16 

23.726 

38.990 

0.601 

8.430 

0.377 

4.090 

60 

421 

50581 

101583 

16 

26.319 

41.510 

0.618 

8.390 

0.378 

4.090 

64 

449 

57537 

115523 

16 

29.587 

45.210 

0.609 

8.410 

0.403 

4.090 
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Table  B2  —  Timings  for  the  Nettaik  Implementation  of  a  Continuous  Mapping  Net 
Compiled  with  Software  Floating  Point 


Units  Connections  Processors  VP  Make  (s)  FF  (s)  BP  (s) 


0.117 

0.220 

0.218 

0.320 

0.478 

8.630 

0.885 

0.990 

1.454 

I. 560 
2.334 
3.430 
3.591 

10.600 

4.684 

7.740 

5.910 

10.950 

8.694 

21.600 

10.282 

23.010 

II. 998 
23.710 

13.933 

23.860 

21.165 

36.950 

23.880 

39.200 

26.345 

41.510 

29.512 

45.100 


1 

8 

18 

44 

4 

29 

237 

503 

8 

57 

921 

1899 

12 

85 

2053 

4191 

16 

113 

3633 

7379 

20 

141 

5661 

11463 

24 

169 

8137 

16443 

28 

197 

11061 

22319 

32 

225 

14433 

29091 

36 

253 

18253 

36759 

40 

281 

22521 

45323 

44 

309 

27237 

54783 

48 

337 

32401 

65139 

52 

365 

38013 

76391 

56 

393 

44073 

88539 

60 

421 

50581 

101583 

64 

449 

57537 

115523 
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Table  B3  —  Timings  for  the  Nettalk  Implementation  of  an  Associative  Memory  Net 
Compiled  with  Hardware  Floating  Point 


N 

Units 

Connections 

Processors 

VP 

Make  (s) 

FF  (s) 

BP(s) 

Ratio 

CM 

Total 

CM 

Total 

CM 

Total 

1 

9 

4 

17 

1 

0.075 

0.120 

■nB  M 

■wi 

4 

36 

68 

172 

1 

0.110 

0.150 

0.131 

0.310 

0.018 

0.020 

8 

72 

264 

600 

1 

0.179 

0.220 

0.135 

0.300 

0.018 

0.020 

12 

108 

527 

1162 

1 

0.280 

0.320 

0.137 

0.300 

0.018 

0.020 

16 

144 

1033 

2210 

1 

0.468 

0.510 

0.126 

0.290 

0.018 

0.020 

20 

180 

1564 

3308 

1 

0.659 

0.700 

0.136 

0.300 

0.017 

0.020 

24 

216 

2265 

4746 

1 

0.917 

0.960 

0.136 

0.300 

0.017 

0.020 

28 

252 

3152 

6556 

1 

1.235 

1.280 

0.128 

0.290 

0.018 

0.020 

32 

288 

3988 

8264 

2 

1.627 

2.640 

0.185 

0.320 

0.028 

0.030 

36 

324 

5071 

10466 

2 

2.012 

3.030 

0.173 

0.310 

0.028 

0.030 

40 

360 

6413 

13186 

2 

2.547 

3.570 

0.175 

0.310 

0.028 

0.030 

44 

396 

7821 

16038 

2 

3.005 

4.020 

0.267 

0.470 

0.028 

0.030 

48 

432 

8241 

16914 

■ 

3.457 

10.370 

0.431 

0.590 

0.059 

0.060 

52 

468 

10733 

21934 

0 

4.317 

7.250 

0.415 

0.570 

0.059 

0.060 

56 

504 

12607 

25718 

5.030 

6.950 

0.424 

0.580 

0.059 

0.060 

60 

540 

14300 

29140 

■ 

5.629 

6.550 

0.430 

0.590 

0.058 

0.060 

64 

576 

16475 

33526 

8 

7.223 

21.480 

0.752 

0.870 

0.122 

4.090 
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Table  B4  —  Timings  for  the  Nettalk  Implementation  of  an  Associative  Memory  Net 
Compiled  with  Software  Floating  Point 


N 

Units 

Connections 

Processors 

VP 

Make  (s) 

FF  (s) 

BP  (s) 

Ratio 

CM 

Total 

CM 

Total 

CM 

Total 

1 

9 

4 

17 

1 

0.084 

0.130 

-0.005 

0.030 

4 

36 

64 

164 

1 

0.113 

0.160 

0.027 

0.030 

8 

72 

258 

588 

1 

0.189 

0.230 

0.147 

0.310 

0.027 

0.030 

12 

108 

638 

*  1384 

1 

0.319 

0.360 

0.103 

0.300 

0.027 

0.030 

16 

144 

1041 

2226 

1 

0.479 

0.520 

0.136 

0.300 

0.027 

0.030 

20 

180 

1544 

3268 

1 

0.668 

0.710 

0.146 

0.320 

0.027 

0.030 

24 

216 

2294 

4804 

1 

0.940 

0.990 

0.138 

0.300 

0.027 

0.030 

28 

252 

3070 

1 

6392 

1 

1.205 

1.250 

0.145 

0.310 

0.027 

0.030 

32 

1 

288 

4076 

8440 

2 

1.668 

2.690 

0.195 

0.330 

0.038 

0.040 

36 

324 

5165 

10654 

2 

2.059 

3.080 

0.194 

0.330 

0.038 

0.040 

40 

360 

6369 

13098 

2 

2.507 

3.530 

0.284 

0.490 

0.038 

0.040 

44 

396 

7637 

15670 

2 

2.943 

3.960 

0.290 

0.490 

0.038 

0.040 

48 

432 

8228 

16888 

■ 

3.454 

8.380 

0.434 

0.590 

0.069 

0.070 

52 

468 

10811 

22090 

m 

4.354 

6.290 

0.437 

0.600 

0.059 

0.060 

56 

504 

12592 

25688 

D 

5.126 

6.060 

0.442 

0.600 

0.068 

0.070 

60 

64 

540 

576 

14342 

16362 

29224 

33300 

5.689 

7.610 

7.276 

21.490 

0.436 

0.600 

0.779 

0.900 

0.069 

0.070 

0.131 

4.090 

64 


576 


16362 


33300 
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Table  B5  —  Timings  for  the  Toniboulian  Implementation  of  a  Continuous  Mapping  Net 
Compiled  with  Hardware  Floating  Point 
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Table  B6  —  Timings  for  the  Tomboulian  Implementation  of  an  Associative  Memory  Net 
Compiled  with  Hardware  Floating  Point 
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Appendix  C 

♦LISP  CODE  FOR  NETTALK  IMPLEMENTATION 


;;;  Mode:  LISP;  Syntax:  Common-lisp;  Package:  eLISP;  Base:  10 
(in-package  ’*lisp) 


Etienne  Deprit 

■aval  Research  Lab,  Code  8242 


■ettalk  Implementation 

Pvar  Types 

MII-IIT-PVIR 

CUBE-ADDRESS-PVAR 

SLAB-iO-PVAR 

UilT-IO-PVAR 

BUIDLE-IO-PVAR 

COilECTIOI-iO-PVAR 


;  Pvar  type  field  sizes 

(defvar  *cm-max-int») 

(defvar  *slab-no-size») 

(defvar  eunit-no-size*) 

(defvar  ‘bundle-no-sizev) 

(defvar  *connection-no-8ize«) 

;  Set  field  sizes  in  compiler’s  environment 

(eval-Bhen  (compile  load  eval) 

(setf  ecm-max-int*  (eipt  2  16)) 

(setf  *slab-no-aizo*  16) 

(setf  •iinit-no-size*  16) 

(setf  ebundle-no-size*  16) 

(setf  •connection-no-size*  32) 

) 

;  Define  pvar  types 

(deftype  max-int-pvar  ()  ’(pvar  (unsigned-byte 

#.(1+  (ceiling  (log  ecm-max-int*  2)))))) 

(deftype  cube-address-pvar  ()  ’(pvar  (unsigned-byte 

•  log-number-of -processors-limit  * ) ) ) 

(deftype  slab-no-pvar  ()  ’(pvar  (unsigned-byte  f . vslab-no-size*) ) ) 

(deftype  unit-no-pvar  ()  ’(pvar  (unsigned-byte  f . eunit-no-size*) ) ) 

(deftype  bundle-no-pvar  ()  ’(pvar  (unsigned-byte  • . »bundle-no-size*) )) 


unsigned  byte  tO  ,  2*16-1] 

unsigned  byte  [0  ,  *log-number-of-proce8sors-limit»] 

unsigned  byte  [0  ,  2*16-1] 

unsigned  byte  [0  ,  2*16-1] 

unsigned  byte  [0  ,  2*16-1] 

unsigned  byte  [0  ,  2*32-1] 
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(deftjp«  connect ion-no-pvar  ()  ’ (p»ar  (unsignad-bjta  t .econnaction-no-size*) ) ) 

;  When  using  simlator,  add  nea  pear  type  syabols 

•+ : elisp-sinulator 
(progn 

(pushnee  'Bax-int-pear  **lisp-etported-type-8yBbolB») 

(pushnea  ’cube-address-paar  eelisp-exported-type-syBbols*) 

(poshnea  ’slab-no-paar  **lisp-ezported-type-syBbola*) 

(pushnea  ’unit-no-p»ar  **lisp-ezportad-type-syBbcls*) 

(pushnea  ’bundle-no-pvar  eelisp-expoTted-type-syabols*) 

(pushnea  ’ connect ion-no-p*ar  eelisp-exported-type-synbols*) 

) 

; ; ;  EOF 
t+: ccl 

(format  t  "■%\"Pvar  TypesN"  loaded") 


;;;  Mode:  LISP;  Syntax:  Common'lisp;  Package:  «LISP;  Base:  10 
(in-package  ’*lisp) 

I  t  t 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 

I  >  * 

I  •  I 

;;;  lettalk  Implementation 
;;;  Utilities 


:  COUIT-CSS  returns  the  number  of  processors  in  the  currently  selected  set . 

(defun  count-css  () 

(•sum  (!!  1))) 

;  mi-IIT!!  returns  a  field  pvar  containing  •CH-(UX-IIT« . 

(defmacro  max-int!!  () 

’(the  maur-int-pTar  (!!  *cm-max-int»))) 

;  RIIDOH-FLOIT ! !  returns  a  random  float  paar  eaenly  distributed  in  the  interval 
;  (mean- int era al  ,  mean+ inter aal]  in  each  processor. 

#- : ♦lisp-simulator 

(•proclaim  ’(ftype  (function  (t)  (paar  single-float)}  random-float!!)) 

(•defun  random-float!!  (mean!!  interaal!!) 

(declare  (type  float-paar  mean!!  interaal!!)) 

(+ ! !  mean! ! 

(•  ! !  interaal ! ! 

(if!!  (=!!  (random!!  (!!  2))  (!!  D) 

(! !  1.0) 

(! !  -1.0)) 

(/!!  (random!!  (max-int!!)) 

(max-int !!))))) 

;  FORHIT-PVARS  pretty  prints  the  giaen  list  of  PVARS.  Additional  keyeord  arguments 
;  Bill  be  passed  in  to  PRETTY-PRIIT-PVAR . 
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(dofmacro  fonaat-pvara  (pvars  treat  keya  tkey  talloa-other-  keys) 

‘ (progn 

,C(mapcaji  t’ (lambda  (pvar) 

*  ((format  t  “*%''a'*  (pvar-name  ,p»ar))  (ppp  yp^ar  ,Ckeys))) 
pvars)) ) 

;  HULTIPLE-VALUE-SETF  sets  the  locations  referenced  by  4CCESS0R-F0RMS 
;  to  the  multiple  values  returned  by  VALUES-FORM. 

(defmacro  multiple-value-setf  (accesor-f orms  values-form) 

(let  ( (values-list  (gensym)) 

(i  -D) 

‘ (let  ( ( , values-list  (multiple-value-list  , values-form) ) ) 

(setf  ,€(mapc2Ui  (lambda  (accessor-form) 

‘ ( ,accessor-form  (nth  ,(incf  i)  , values-list) ) ) 
accesor-f orms) ) ) ) ) 

;  PHIST-VEC  prints  the  array  VEC  on  STREAK  oith  the  given  ELEKEHTS-PER-LIITE . 

;  Each  element  is  printed  using  ELEMEIT-FORMAT ,  and  each  line  of  output  is 
;  proceeded  by  lEW-LIIE-FORKAT . 

(defun  print-vec  (vec  ftoptional  (stream  t) 

Akey  elements-per-line  (element -format  "*8  ")  (new-line-forrnat  "'*/,")) 
(dotimes  (i  (length  vec)) 

(if  (and  elements-per-line 

(zerop  (mod  i  elements-per-line))) 

(format  stream  neo-line-format)) 

(format  stream  ’'’C?”  element-format  (aref  vec  i))) 

(values)) 

;  PRIIT-IO-VECS  prints  the  IBPUT  and  OUTPUT  vectors. 

(defun  pr int-io-vecs  (input  output) 

(format  t  "’%i:  ")  (print-vec  input) 

(format  t  "  o:  ")  (print-vec  output)) 

i  LIST-TO-ARRAY-PAIRS  coerces  the  list  of  LIST-PAIRS  into  a  list  of  array  pairs. 

(defun  list-to-array-p«: .rs  (list -pairs) 

(let  (input  target) 

(map  *list 

•’(lambda  (pair) 

(setf  input  (first  pair) 

target  (second  pair)) 

(list 

(make-array  (length  input)  : initial-contents  input) 

(make-array  (length  target)  : initial-contents  t^u:get))) 
list-pairs) ) ) 

;  LIST-TO-ARRAY  coerces  the  list  of  lists  into  a  list  of  arrays. 

(defun  1 ist-to-array  (list) 

(map  ’list 

k ’ (lambda  (sub-1 ist ) 

(make-array  (length  sub-list)  : initial-contents  sub-list)) 

list) ) 

, i ,  EOF 
•+:ccl 

(format  t  " ■yA"Ut ilit ies\"  loaded") 
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;;;  Node:  LISP;  Syntax:  Common-lisp;  Package:  *LISP;  Base:  10  -* 
(in-packaga  ’*lisp) 


Etienne  Deprit 

■axal  Research  Lab,  Code  8242 


■ettalk  Implementation 
Processor  Allocation 


CH  Dimensions 


*CH-DinEISIOIS*  is  a  list  of  CH  configurations.  Each  configuration  is  a  list 
of  the  total  number  of  processors  and  the  corresponding  CH  dimensions . 


(defvar  *cm-dimensions* 

(mapcar  t * (lambda  (dims) 

(list  (reduce  #’• 
•+ :*li3p-hard8are 
'((  64  128) 

(  128  128) 

(  128  256) 

(  256  256) 

(  256  512) 

(  512  512) 

(  512  1024) 

(1024  1024)) 

•+: ‘lisp-simulator 
’((4  4) 

(6  4) 

(6  6) 

(8  6) 

(8  8)) 

)) 


dims)  dims)) 

;  8X  machine 
;  VP  ratio  =  1 

;  =  2 

;  =  4 

;  =  8 

;  =  16 

;  =  32 

;  »  64 

;  «  128 


;  CH-BEST-FIT-DIHS  returns  the  minimum  CH  dimensions  necessary 
;  to  satisfy  the  request  for  lO-PROCESSORS . 

(defun  cm-best-f it-dims  (no-processors) 

(second  (assoc  no-processors 

•cm-dimensions* 

:test  t’<=))) 


Processor  Allocator  -  allocate  contiguous  blocks  of  free  processors,  no  deallocation 


;  ‘lEXT-FREE-PROCESSOR*  contains  the  cube  address  of  the  next  free  processor. 

(def»ar  ‘next-f ree-processor*  0) 

;  RESET-PALLOC  reset  the  processor  allocator. 

(defun  reset-palloc  () 

(setf  ‘next-free-processor*  0) 
t) 

;  I-PROC-LEFT-P  returns  T  if  there  are  I  free  processors  a»ailablo  or 
;  signals  an  error  if  there  are  too  fee  free  processors  left. 
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(defiin  n-proc-laf t-p  (n) 

(or  (<»  (♦  anext-fraa-procesBor*  n)  annmbar-ol-procaBBors-liJiita) 

(arror  “PUXCXl  can’t  allocate  "a  processor* ;a*[8'; ;b'] "  n))) 

;  PILLOC  allocates  the  next  I  free  processors. 

(defnn  palloc  (n) 

(shen  (n-proc-left-p  n) 

(progl 

♦next-lree-processor* 

(incf  •next-free-processor*  n)))) 

■  PiLLOC-1  allocates  a  single  free  processor. 

(defmacro  palloc-1  () 

’(palloc  1)) 

;  FOR-PROCESSOR-BLOCK  executes  BODY  eith  the  currently  selected  set  composed 
;  of  the  block  of  SIZE  processors  beginning  at  START-ADDR. 

(defmacro  f or-processor-block  ((start-addr  size)  Abody  body) 

‘(♦ehen  (<=!!  (the  cube-address-pvar  (!!  , start-addr)) 

(self-address ! ! ) 

(the  cube-address-pvar  (!!  (1-  (+  , start-addr  ,size))))) 

.Cbody) ) 

;  WlTH-1-PRQC-AU.QCiTED  allocates  a  block  of  I  processors,  sets  ADDR 
;  to  the  starting  address  of  the  block  and  executes  BODY  sith  the 
i  currently  selected  set  composed  of  the  nealy  allocated  processors. 

I 

(defmacro  »ith-n-proc-allocat«d  (<n  addr) 

tbody  body) 

'(let  ((,addr  (palloc  ,ii))) 

(for-procesaor-block  (^addr  ,n) 

,«body))) 

;  In  Allegpro  CL,  set  FRED  indentation  for  macros 

#+;ccl 

(progn 

(pushnev  ’ (eith^n-proc-allocated  .  1) 

ccl: : efred-special-indent-aliste 
:test  # ’equal) 

(pushnev  ’ (f or-processor-block  .  1) 

ccl: :ef red-spec ial-indent-aliste 
:test  # ’equal)) 

;  Reset  Processor  Allocator  after  *C0LD-B00T, 
f + : «lisp-hard«are 

(add-initialization  "Reset  Palloc" 

’(reset-palloc) 

’*after-*cold-boot-init ializat ions*) 

#+: *lisp-simulator 

(add-initialization  :name-of-fonn  "Reset  Palloc" 

:form  ’(reset-palloc) 

: variable  ’ eafter-ecold-boot -initializations*) 


; ; ;  EOF 
#+ : ccl 

(format  t  ""%\"Proce88or  AllocationX"  loaded") 
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;;;  Hods:  LISP;  Syntax;  Coonon-lisp;  Packaga:  aLISP;  Baaa:  10 
(in-package  ’eliap) 

; ; ;  Etienne  Deprit 

latal  Research  Lab,  Code  8242 


■ettalk  Implementation 
leural  let  Front-End  Structures 
SLAB  set  of  units 

BUIDLE  set  of  connections  beteeen  2  slabs  eith  density  0-100% 
■ET  sets  of  slabs  and  bundles, 

eith  input  k  output  slab  (possibly  the  same) 
represents  CQITIIUOUS-MAPPIIG  or  ASSOCIATIVE-HEHORY  not 


Slab  of  units 


(defstruct 


no 

inputp 

outputp 

size 

) 


(net-slab 

t+ : symbolics 
( : named) 

( : conc-name  slab-) 

(; constructor  f e-make-slab-internal) 

(: print -function  print-slab) 

) 

;  slab  id 
;  input  slab? 

;  output  slab? 
;  no  of  xinits 


;  PRIIT-SLAB  prints  SLAB  on  STREAM. 

(defun  print-slab  (slab  stream  toptional  depth) 

(declare  (Ignore  depth)) 

(forsiat  stream  "#<Slab  "a,  "a  unit "  ; [s' ; " ;  ;a']  * : ;  I"]':[";  0")>" 
(slab-no  slab)  (slab-size  slab) 

(slab-inputp  slab)  (slab-outputp  slab))) 


;  SLAB-10!!  returns  a  slab-no-pvar  pvar  containing  the  SLAB  id  in  each  processor. 

(defmacro  slab-no!!  (slab) 

‘(the  slab-no-pyar  (!!  (slab-no  ,slab)))) 

;  SLAB-IiPUTP! !  returns  a  boolean  p»ar  containing  T  if  SLAB  is  the  input  slab. 


(defmacro  slab-inputp! !  (slab) 

‘(the  boolean-pyar  (!!  (slab-inputp  ,slab)))) 

;  SLAB-OUTPUT!!  returns  a  boolean  pvar  containing  T  if  SLAB  is  the  output  slab. 

(defmacro  slab-outputp!!  (slab) 

‘(the  boolean-pvar  (!!  (slab-outputp  ,slab)))) 


;  Bundle  of  connections 

(defstruct  (net-bundle 

t+: symbolics 
( : named) 
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no 

to-slab 

from-slab 

density 

size 

to-no 

from-no 

) 


(.'conc'name  bundle*) 

(: constructor  fe*make*bundle*intemal) 

( :print-function  print*bundle) 

) 

;  bundle  id 
;  connections  to  slab 
;  connections  froB  slab 
;  density  of  connections,  0*100% 
;  no  of  connections 
;  connection  »  (to*no, from-no) 

;  array  of  to*slab  unit  ids 
;  array  of  froB-slab  unit  ids 


;  PRIIT-BUIDLE  prints  BUIDLE  on  STREAM. 

(defun  print-bundle  (bundle  stream  Aoptional  depth) 
(declare  (ignore  depth)) 

(format  stream  "t<Bundle  “a  <-  "a, 

(slab-no  (bundle-to-slab  bundle)) 

(slab-no  (bundle-from-slab  bundle)) 
(bundle-density  bundle))) 


;  BUIDLE-IO!!  returns  a  bundle-no-pvar  pvar  containing  the  BUIDLE  id  in  each  processor. 

(defmacro  bundle-no!!  (bundle) 

*(the  bundle-no-pvar  (!!  (bundle-no  , bundle)))) 


;  leural  net 

(defstruct  (neural-net 

isymbolics 
( : named) 

(:conc-name  net*) 

( rconstructor  f e-make-net*intemal) 

(: print -function  print-net) 

) 

name 
type 

slabs 

input-slab-no 
output-slab-no 
bundles 
no-units 
no-connect  ions 
no-processors 

(a  1 .0) 

(b  1.0) 

(eta  0. 25) 

(alpha  0.9) 

(epsilon-r  0.001) 

(x-iterations  4) 

(epsilon-y  0.001) 

(y-iterations  4) 

(epsilon-u  0.1) 

(max-updates  10000) 

) 

;  PRIIT-IET  prints  lET  on  STREAM. 

(defun  print-net  (net  stream  Aoptional  depth  Akey  verbose-p) 
(declare  (ignore  depth)) 

(if  (not  verbose-p) 

(format  stream 


;  COITIiOUS-HAPPIIC  or  ASSOCIATIVE-HEMDRY 

;  array  of  slabs 
;  input  slab  id 
;  output  slab  id 
;  array  of  bundles 
;  total  number  of  units 

;  connections 

;  processors 

;  dynamical  system  equation  constants 

;  learning  rate 
;  momentum  term 

;  feed-forward  convergence  criterion 
;  min  iterations  before  convergence  test 
;  bacX-propagate  convergence  criterion 
;  min  iterations  before  convergence  test 
;  we*  ^ht  update  convergence  criterion 
;  max  weight  updates  in  training 
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"f<I«t  "a  "a  slab" ; ;8"] ,  *a  bundla" [a" ; * : ;a"]>“ 

(nat-naaa  net) 

(length  (net -slabs  net)) 

(length  (net-bundles  net))) 

(format  stream  "*%*a  net;  'a"  (net-type  net)  (net-name  net)) 

(format  stream  "■2X'a  slab* : [s' ; * : ; s'] ,  'a  bundle' ;e*[s' s"]" 

(length  (net-slabs  net))  (length  (net-bundles  net))) 

(format  stream  "'X'a  unit" ;*'[s'; ' : ;8"] ,  "a  connection":*'[8';"; ;s*]  ->' 

"a  processor" [s' ;8']" 

(net-no-units  net)  (net-no-connectiona  net)  (net-no-processors  net)) 
(format  stream  ""2%a  =  'a,  b  »  “a"  (net-a  net)  (net-b  net)) 

(format  stream  "*2)iFeed-foreard  convergence  =  "a,  min  "a  iteration"  [s' ;s"] " 
(net-epsilon-x  not)  (net-z-iterations  net)) 

(format  stream  "'%Back-propagate  convergence  =  "a,  min  'a  iteration" [s' s'] " 
(net-epsilon-y  net)  (net-y-iterations  net)) 

(format  stream  "'2Xata  >  'a,  alpha  =  "a"  (net-eta  net)  (net-alpha  net)) 

(format  stream  ""^Weight  update  convergence  =  "a,  max  "a  iteration" [s" s'] " 
(net-epsilon-e  net)  (net-maz-updates  net)) 

(terpri  stream) 

) 


;  get-slab  returns  the  slab  eith  id  SLIB-IO  in  lET. 

(defmacro  get-slab  (net  slab-no) 

‘(aref  (net-slabs  .net)  , slab-no)) 

;  GET- IIPUT- SLAB  returns  the  input  slab  in  lET. 

(defmacro  get- input-slab  (net) 

‘(aref  (net-slabs  .net)  (net-input-slab-no  .net))) 

;  GET-OUTPUT-SLAB  returns  the  output  slab  in  lET. 

I 

(defmacro  get-output-slab  (net) 

‘(aref  (net-slabs  .net)  (net-output-slab-no  .net))) 

GET-BUIDLE  returns  the  bundle  sith  id  BUIDLE-IO  in  lET. 

(defioacro  get-bundle  (net  btindlo-no) 

‘(«ef  (net-bundles  .net)  .bundle-no)) 

;  MEMORY-IETP  returns  T  if  lET  is  an  ASSOCIATIVE-BEMORY  not. 

(defmacro  memory-netp  (net) 

‘(eq  (net-type  .net)  ’associative-memory)) 

; ; ;  EOF 

#+;ccl 

(format  t  "'y,\"Iot  FE  StructuresN"  loaded") 


;;;  -•-  Mode:  LISP;  Syntax:  Common-lisp;  Package;  vLISP;  Base:  10  -•- 
(in-package  ’»lisp) 


Etienne  Deprit 

laval  Research  Lab.  Code  8242 
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■ettalk  Implementation 
let  CM  Structures 


■et 


(•proclaim  ’(type  boolean-pvar  netp!!}) 

(•defvar  netp!!  nil!!)  ;  processor  in  not? 


Units 


(•proclaim  ’(type  boolean-prar  unitp!!)) 

(•proclaim  ’(type  boolean-pvar  inputp!!)) 

(•proclaim  ’(type  boolean-pvar  outputp!!)) 

(•proclaim  ’(typo  slab-no-pvar  slab-no!!)) 

(•proclaim  ’(type  unit-no-p»ar  unit-no!!)) 

(•defveir  unitp!!  nil!!) 

(•defvar  inputp!!  nil!!) 

(•defvar  outputp!!  nil!;) 

(•dafvjir  slab-no!!) 

(•defvar  unit-no!!) 

;  Variables  appearing  in  feed-forward  and  back-propagation  equations 

(•proclaim  ’(type  singlo-float-pvar  a!!)) 

(•proclaim  ’(type  single-float-pvar  b!!)) 

(•proclaim  ’(type  single-float-pvar  X!!)) 

(•proclaim  ’(typo  single-float-pvar  Z!!)) 

(•proclaim  ’(type  single-float-pvar  dl!!)) 

(•proclaim  ’(type  singlo-float-pvar  U!!)) 

(•proclaim  ’(typo  single-float-pvar  LogU!!)) 

(•proclaim  ’(type  singlo-float-pvar  I!!)) 

(•proclaim  ’(type  single-float-pvar  Y!!)) 

(•proclaim  ’(type  single-float-pvar  dY!!)) 

(•proclaim  ’(typo  singlo-float-pvar  V!!)) 

(•proclaim  ’(typo  single-float-pvar  J!!)) 

(•defvar  a! !) 

(•defvar  b! ! ) 

(•defvar  X! !) 

(•defvar  Z! ! ) 

(•defvar  dl! !) 

(•defvar  U! !) 

(•defvar  LogU!!) 

(•defvar  I ! ! ) 

(•defvar  Y! ! ) 

(•defvar  dY ! ! ) 

(•defvar  V! ! ) 

(•defvar  J ! ! ) 

(•proclaim  ’(type  singlo-float-pvar  opsilon-i! !)) 

(•proclaim  ’(typo  singlo-float-pvar  epsilon-y! !)) 

(•defvar  epsilon-x!!)  ;  feed-forward  convergence  criterion 

(•defvar  epsilon-y!!)  ;  back-propagato  convergence  criterion 

;  Connections 

(•proclaim  ’(type  boolean-pvar  fan-inp!!)) 

(•proclaim  ’(type  boolean-pvar  fan-outp'!)) 


;  processor  is  unit? 
;  input  unit? 

;  output  unit? 

;  unit  slab  id 
;  unit  id 
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(♦proclaim  ’(typa  bundle'iio'*pTar  bundle^no! !)) 
(♦proclaim  * (type  connect ion-no-pvar  connection-no!!)) 
(♦proclaim  ’(type  slab-no-pvar  to-alab-no! !)) 
(♦proclaim  ’(type  nnit-no-pvar  to-unit-no! ! )) 
(♦proclaim  ’(type  slab-no-pvar  from-slab-no! !)) 
(♦proclaim  ’(type  unit-no-pear  from-\mit-no! !)) 
(♦proclaim  ’(type  cube-address-pear  from-addr ! !)) 
(♦proclaim  ’(type  cube-address-pear  to-addr!!)) 


(♦defear 
(♦defear 
(♦defeaur 
(♦defear 
(♦defear 
(♦defear 
(♦d* f var 
(♦defvar 
(♦defear 
(♦defear 


fan-inp! !  nil!!) 
fan-outp!!  ni*l!!) 
bundle -no ! ! ) 
connection-no ! ! ) 
to-slab-no! !) 
to-unit-no! !) 
from-slab-no! !) 
from-unit-no ! !) 
from-addr ! ! ) 
to-addr! ! ) 


fan-in  veight? 
fan-out  seigbt? 
connection  bundle  id 
connection  id 
to  slab  id 
to  unit  id 
from  slab  id 
from  unit  id 

cube  address  of  from  unit 
cube  address  of  to  unit 


(♦proclaim  ’(type  single-float-pear  W!!)) 
(♦proclaim  ’(type  single-float-pear  dW!!)) 
(♦proclaim  ’(type  single-float-pear  dWold!!)) 


(♦defear  H! ! ) 
(♦defear  dV!!) 
(♦defvar  dVold!!) 


;  connection  eeight 

;  current  weight  change 

;  last  weight  change  (momentum  term) 


(♦proclaim  ’(type  single-float-pear  epsilon-w! !)) 
(♦proclaim  ’(type  single-float-pear  eta!!)) 
(♦proclaim  ’(type  single-float-pear  alpha!!)) 


(♦defvar  epsilon-w!!) 
(♦defvar  eta ! ! ) 
(♦defear  alpha!!) 


;  weight  update  convergence  criterion 
;  learning  rate 
;  momentum  term 


Fan-in  k  Fan-out  Segments 


(♦proclaim  ’(type  boolean-pear  forward-fan-in-seg! !)) 
(♦proclaim  ’(type  boolean-pvar  forward-fan-out-seg! !)) 
(♦proclaim  ’(type  boolean-pear  backward-fan-in-seg! !)) 
(♦proclaim  ’(type  boolean-pear  backward-fan-out-seg! !)) 


;  feed-forward  fan-in  weights 
;  feed-forward  fan-out  weights 
;  back-propagate  fan-in  weights 
;  back-propagate  fan-out  weights 

; ; :  EOF 
#+ :  ccl 

(format  t  '*'yA"(^  Met  StructuresX"  loaded") 


(♦defear  forward-fan-in-seg!!) 
(•defear  forward-fan-out-seg!*) 
(♦defvar  backward-fan-in-seg!!) 
(♦defvar  backward-fan-out-seg!!) 


;;;  -♦-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  ♦LISP;  Base:  10  -♦- 
( in-package  ’♦lisp) 


Etienne  Deprit 

■aval  Research  Lab,  Code  8242 
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lettalk  Implementation 

Make  let  Structures  on  Front-End 


;  Front-End  slab  structure 

;  FE-HARE-SLAB  returns  a  net  slab  of  SIZE  units  with  id  10.  IIPUTP  and  OUTPUTP 
;  indicate  if  this  slab  is  the  input  or  output  slab,  respectively. 

(defun  fe-maXe-slab  (no  size  inputp  outputp) 

(f e-make-slab“intemal  :no  no 
:size  size 
: inputp  inputp 
: outputp  outputp)) 

;  Front-End  bundle  structure 

;  RAIDOH-COPIECTIQIS  returns  ROV  number  and  COL  number  arrays  representing  a  bundl 
;  of  connections  to  a  slab  of  TO-SIZE  units  from  a  slab  of  FROM-SIZE  units. 

;  Each  possible  connection  is  formed  sith  probability  given  by  DEISITY. 

(defun  random-connections  (to-size  from-size  density) 

(let  (n  row  col) 

(setf  density  (/  density  100.0)) 

(♦all 

(♦let  ((rendezvous!!  (!!  0))) 

(declare  (type  cube-address-pvar  rendezvous!!)) 

(♦when  (and!!  (<!!  (self -address !! ) 

(the  mar-int-pvar  (!!  (*  to-size  from-size)))) 

(<!!  (random-float!!  (!!  0.5)  (!!  0.5)) 

(the  float-pvar  (!!  density)))) 

(setf  n  (count-css)) 

(•pset  :no-collisiona 

(self-address ! ! ) 
rendezvous! ! 

(enumerate! !))) 

(setf  row  (make-array  n) 
col  (make-array  n)) 

(pvar-to-array  (truncate!!  rendezvous!!  (!!  from-size)) 
row 

: cube-address-end  n) 

(pvar-to-array  (mod!!  rendezvous!!  (!!  from-size)) 
col 

: cube-address-end  n))) 

(values  roe  col))) 

,  FE-MAKE-BUIDLE  returns  a  bundle  with  id  10  connecting  TO-SLAB  and  FROM-SLAB 
;  with  the  probability  of  each  connection  given  by  DEISITY. 

(defun  f e-make-bundle  (no  to-slab  from-slab  density) 

(let  ((bundle  (fe-make-bundle-internal 
:no  no 

:to-8lab  to-slab 
:from-8lab  from-slab 
:density  density))) 

(molt iple-value-setf 
( (bundle-to-no  bundle) 

(bundle-f rom-no  bundle)) 

(random-connections  (slab-size  to-slab) 

(slab-size  from-slab) 
density) ) 

(setf  (bundle-size  bundle)  (length  (bundle-to-no  bundle))) 
bundle) ) 

;  Front-End  net  structure 
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;  i  bundle  spec  is  a  list  of  the  fora  (<to  slab  id>  <froa  slab  id>  <density>). 

(defstruct  (bundle-spec 

(:type  list)) 

to-slab 

from-slab 

density) 

:  FE-MiKE-IET  returns  the  net  IIHE  of  the  given  TYPE  (COITIIOUS-mPPIIG  or 
;  ISSOCIiTIVE-HEHORY) .  SLABS  Bust  be  a  list  of  total  units  in  each  slab,  and 
;  IIPUT-SLIB'IO  and  OUTPUT-SLAB-IO  identify  the  input  and  output  slabs, 

:  respectively.  BUIDLES  must  be  a  list  of  bundle  specifications.  Additional 
;  keysord  arguments  are  passed  in  to  FE-HAKE-IET-IITERIAL  allouing  other 
;  net  parameters  to  be  set . 

(defun  fe-make-net  (name  type  slabs  input-slab-no  output - si ab-no  bundles 
trest  other-net-keys  kkey  tallow-other-keys) 

(let  ((net  (apply  f’fe-make-net-internal 
rname  (string  name) 
itype  type 

: input-slab-no  input-slab-no 
: output-slab-no  output-slab-no 
other-net -key s ) ) ) 

(let  ((slab-no  -1)) 

(setf  (net-slabs  net) 

(map  ’ array 

t> (lambda  (slab-size) 

(fe-make-slab  (incf  slab-no) 
slab-size 

(eq  input-slab-no  slab-no) 

(eq  output-slab-no  slab-no))) 

slabs))) 

(let  ((bundle-no  -1)) 

(setf  (net-bundles  net) 

(map  ’ array 

A '(lambda  (bundle) 

(fe-make-bundle  (incf  bundle-no) 

(get-slab  net  (bundle-spec-to-slab  bundle)) 
(get-slab  net  (bundle-spec-from-slab  bundle)) 
(bundle-spec-density  bundle))) 

bundles))) 

(fe-size-net  net) 
net)) 

;  FE-SIZE-IET  sets  the  total  number  of  tuvits,  connections  and  processors  required  by  NET. 

(defun  fe-size-net  (net) 

(setf  (net-no-units  net) 

(reduce  #’+ 

(map  'list  f'slab-size  (net-slabs  net))) 

(net -no-connect ions  net) 

(reduce  #’+ 

(map  'list  i’bundle-size  (net-bundles  net))) 

(net-no-processors  net) 

(+  (net-no-units  net) 

(*  2  (net-no-connections  net))))) 

;  CONTINUOUS-MAPPING  net 

1  DEF-HAPPING-NET  returns  a  CONTINUOUS-HAPPING  net  called  NAME  specified  by 
;  the  keyword  argguments  SLABS,  INPUT-SLAB-NO,  OUTPUT-SLAB-NO  and  BUNDLES. 

;  Additional  keyword  arguments  can  be  used  to  specify  other  net  parameters. 

(defmacro  def-mapping-net  (name  trest  other-net-keys 

tkey  slabs  input-slab-no  output-slab-no  bundles 
tallow-other-keys) 

‘ (progn 

(defvar  .name) 

(setf  .name  (fe-make-net  ’.name 
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’  continuous'Bapping 
, slabs 

, input-slab-no 
, output-slab-no 
, bundles 

^•other-net-keys)) 

(cm-net-cold-boot  ,naBe) 

(aa-nake-net  .name))) 

;  ASSOCIATIVE-HEMQRY  net 


DEF-HEMORY-IET  returns  an  ASSOCIATIVE-MEMORY  net  called  lAME  specified  by 
the  keyword  argguiaents  SLABS,  IIPUT-SLAB-IO  and  BUIDLES.  Additional  keyword 
arguments  can  be  used  to  specify  other  net  parameters. 


(defmacro  def-memory-net  (name  treat  other-net-keys 

kkey  slabs  input-slab-no  bundles 
tallow-other-keys) 

* (progn 

(defvar  ,name) 

(setf  ,naae  (fe-maJce-net  ^  .name 

’ assoc iat iwe-memory 
, slabs 

, input-slab-no 
, input-slab-no 
, bundles 

i^other-net-keys)) 

(cm-net-cold-boot  ^name) 

(cm-make-net  ,nane))) 


: ; ;  EOF 
#+;ccl 

(format  t  ***%\"FE  Make  letX*'  loaded*') 


I 


;;;  Mode:  LISP;  Syntax:  Common-lisp;  Package:  eLISP;  Base:  10  -*- 

(in-package  ^elisp) 


Etienne  Deprit 

laval  Research  Lab,  Code  8242 


lettalk  Implementation 
Make  let  Structures  on  CM 


CM  slab  structure 


;  CN-MAKE-SLAB  creates  the  structure  for  SLAB  on  the  CM. 

(defun  cm-make-slab  (slab) 

(let  ((slab-size  (slab-size  slab))) 

(with-n-proc-allocated  (slab-size  slab-start) 

(*set  netp! !  t ! ! 

unitp ! !  t ! ! 

inputp!!  (slab-inputp! f  slab) 
outputp! !  (slab-outputp! !  slab) 
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slab-no!!  (slab-no!!  slab) 
unit-no!!  (enumerate!!)))) 

slab) 


CH  bundle  structure 


;  CH-HUE-BUIDLE  creates  the  structure  for  BUIDLE  on  the  CM. 

;  II-QUT  may  specify  a  bundle  of  FlI-II  or  Fll-QUT  ueights. 

(defun  cm-make-b\udle  (bundle  in-out) 

(assert  (member  in-out  ’(;fan-in  ;fan-ont)) 

(in-out) 

"II-OOT  must  be  :FAI-II  or  :FiI-0UT“) 

(let  ((to-slab  (bundle-to-slab  bundle)) 

(from-slab  (bundle-from-slab  bundle)) 

(bundle-size  (bundle-sii.e  bundle))) 

(sith-n-proc-allocated  (bundle-size  bundle-start) 

(*set  netp! !  t ! ! 

bundle-no!!  (bundle-no!!  bundle) 
connection-no!!  (enumerate!!) 
to-slab-no!!  (slab-no!!  to-slab) 
f rom-slab-no ! !  (slab-no!!  from-slab)) 

(if  (eq  in-out  ;fan-in) 

(*set  fan-inp!!  t!!) 

(*set  fan-outp! !  t!!)) 

(array-to-p»ar  (bundle-to-no  bundle) 
to-unit-no ! ! 

: cube-address-start  bundle-start 
; cube-address-end  (+  bundle-start  bundle-size)) 
(array-to-pvar  (bundle-from-no  bundle) 
from-unit-no ! ! 

;cube-addresa-start  bundle-start 
; cube-address-end  (♦  bundle-start  bundle-size)))) 

bundle) 


CM  net  structure 


;  CM-IET-COLD-BOOT  cold  boots  the  CM  with  the  dimensions  necessary  for  BET. 
(defun  cm-net-cold-boot  (net) 

(let  ((cm-dims  (cm-best-f it-dims  (net-no-processors  net)))) 

(or  cm-dims 

(error  "let  'a  too  large  for  CH"  (net-name  net))) 

(•cold-boot  : initial-dimensions  cm-dims))) 

;  CH-HAKE-IET  creates  the  structure  for  lET  on  the  CM. 

(defun  cm-make-net  (net) 

(map  nil  t’ (lambda  (bundle) 

(cm-mahe -bundle  bundle  : fan-in)) 

(net-bundles  net)) 

(map  nil  t’ (lambda  (slab) 

(cm-make-slab  slab)) 

(net-slabs  net)) 

(map  nil  t’ (lambda  (bundle) 

(cm-make-bundle  bundle  : fan-out)) 

(net -bundles  net)) 

(cm-sort-net  net) 

(♦all 

(•when  unit,'!  ! 

(•set  a!!  (the  float-pwar  (!!  (net-a  net))) 
b! !  (the  float-pvar  (!!  (net-b  net))) 
epsilon-*'!  ^the  float-pvar  (!!  (net-epsilon-r  net))) 
epsilon-y!!  (tha  float-pvar  (!!  (net-epsilon-y  net)))) 

(•when  outputp!! 
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(*set  epsilon~8!!  (the  float-pvar  (!!  (nat-apsilon-s  net)))))) 
{•when  fan-outp; ! 

(•set  eta!!  (the  float-p*ar  (!!  (net-eta  net))) 

alpha!!  (the  float-pear  (!!  (net -alpha  net)))))) 

( cm-make - s egnent a ) 

(cm-reset -weights) 
net) 


Sort  CM  net  structures 


;  CH-SORT-IET  sorts  the  structures  of  lET  on  the  CH  to  establish  the 
:  proper  interleaving  of  fan-in  weights,  units  and  fan-out  weights. 

(defun  cm-sort-net  (net) 

(•all 

(•let  (key !  ! 

rank! ! ) 

(declare  (type  (pear  (unsigned-byte  (+  *alab-no-sizee  ennit-no-sizee) ) )  key!!)) 
(declare  (type  cube-address-pvar  rank!!)) 

(•when  (or!!  unitp! !  fan-inp!!  fan-outp!!) 

(•set  key ! ! 

(cond! !  (fan-inp!!  to-slab-no ! ! ) 

(unitp ! !  slab-no ! ! ) 

(fan-outp ! !  from-slab-no ! ! ) 

(t! !  (! !  0)))) 

(•set  key!!  (ash!!  key!!  (the  unit-no-pear  (!!  eunit-no-sizee)))) 

(•set  key ! ! 

(+! !  key! ! 

(cond!!  (fan-inp!!  to-unit-no ! ! ) 

(unitp!!  unit-no!!) 

(fan-outp ! !  f i.oBi-unit-no ! ! ) 

(t!!  (!!  0))))) 

(•set  rank!!  (rank!!  key!!  '<=!!)) 

(cm-sort-units  rank!!) 

(cm-sort-connections  rank!!) 

(map  nil  t’cm-link-bundle  (net-bundles  net)) 

))) 

net) 

:  CH-SORT-UIITS  copies  the  units  to  the  cube  addresses  in  TO-tDDR!!. 

(defun  cm-sort-units  (to-addr!!) 

(declare  (type  cube-address-pear  to-addr!!)) 

(•when  unitp! ! 

(•set  unitp!!  nil!!) 

(•pset  : no-collisions  t!!  unitp!!  to-addr!!) 

(•when  inputp!! 

(•set  inputp!!  nil!!) 

(•pset  : no-collisions  t!!  inputp!!  to-addr!!)) 

(•when  outputp!! 

(•set  outputp!!  nil!!) 

(•pset  : no-collisions  t!!  outputp!!  to-addr!!)) 

{•pset  : no-collisions  slab-no!!  slab-no!!  to-addr!!) 

(•pset  : no-collisions  unit-no!!  \init-no!!  to-addr!!) 

)) 

;  CH-SORT-COlIECmOIS  copies  the  fan-in  and  fan-out  weights  to 
;  the  cube  addresses  in  TO-IDDR!!. 

(defun  cm-sort-connections  (to-addr!!) 

(declare  (type  cube-address-pear  to-addr!!)) 

(•when  (or!!  fan-inp!!  fan-outp!!) 

(•when  fan-inp ! ! 

{•set  fan-inp!!  nil!!) 

(•pset  :no-collisions  t!!  fan-inp!!  to-addr!!)) 
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(««hen  fan-outp! ! 

(•set  fan-outp!!  nil!!) 

(•pset  : no-collisions  t!!  fan-outp!!  to-addr!!)) 

(•pset  : no-collisions  bundle-no!!  bundle-no!!  to-addr !!) 

(•pset  : no-collisions  connection-no!!  connection-no!!  to-addr!!) 

(•pset  : no-collisions  to-slab-no!!  to-slab-no!!  to-addr! !) 

(•pset  :no-collisions  to-unit-no!!  to-unit-no!!  to-addr!!) 

(•pset  : no-collisions  froa-slab-no ! !  fron-slab-no ! !  to-addr!!) 

(•pset  :no-collisions  from-unit-no ! !  from-unit-no ! !  to-addr!!) 

)) 

;  CM-LIIK-BUIDLE  links  the  fan-in  and  fan-out  eeights  of  BUIDLE. 

(defun  cm-llnk-bundle  (bundle) 

(let  ((to-slab  (bundle-to-slab  bundle)) 

(f rom-slab  (bundle-f rom-slab  bundle) ) ) 

(•a''  1 

(•let  (in-rendezvous!! 

out -rendezvous ! ! ) 

(declare  (type  cube-address-pvar  in-rendezvous!!  out-rendezvous!!)) 

(•when  (eoid!!  (or!!  fan-inp!  !  fan-outp!!) 

(=! !  to-slab-no!!  (the  slab-no-pvar  (!!  (slab-no  to-slab)))) 

(»! !  from-slab-no ! !  (the  slab-no-pvar  (!!  (slab-no  f rom-slab) ))) ) 
(♦when  fan-inp!! 

(•pset  :no-collisiona  (self-address ! ! )  in-rendezvous!!  connection-no!!)) 
(•when  fan-outp! ! 

(•pset  :no-collisions  (self -address !! )  out-rendezvous!!  connection-no!!)) 
(♦when  fan-inp! ! 

(•set  from-addr!! 

(the  cube-address-pvar 

(pref!!  out -rendezvous ! !  connection-no!! 

: collision-mode  : no-collis ions) ) ) ) 

(•when  fan-outp!! 

(•set  to-addr!! 

(the  cube-address-pvar 

(pref! !  in-rendezvous! !  connect  ion-no! ! 

: collision-mode  :no-collisions)))) 

))))) 


Hake  CM  segments  for  feed-forward  and  back-propagate  cycles. 


CH-NAKE-SCGHEITS  makes  the  segments  pvars  used  during  scanning  operations 
in  the  feed-forward  and  back-propagate  cycles. 


(defun  cffl-make-segaents  () 

(•when  netpl ! 

(•set  f orward-fan-out-seg! !  (or!! 
f orward-fan-in-seg ! ! 

(or!!  (scan!!  (or!!  unitp!! 

: segment -pvar 
: include-self 


unitp!!  fan-inp!!) 

fan-outp!!)  'and!! 

(or!!  imitp!!  fan-outp!!) 
nil) 


fan-outp! ! ) 

backward-fan-in-seg! !  (or!!  unitp!!  fan-outp!!) 
backwaxd-f an-out-seg! ! 

(or!!  (scan!!  (or!!  unitp!!  fan-inp!!)  'and!! 

: segment-pvar  (or!!  unitp!!  fan-inp!!) 
: direct  ion  ; backward 
: include-self  nil) 
fan-inp! ! ) ) 


)) 


;  CM-RESET-WEIGHTS  resets  the  fan-out  weights  for  each  connection  in  the  net 
;  to  a  random  float  in  the  interval  [mean-interval  ,  mean-^interval]  ■ 

(defun  cm-reset-weights  (loptional  (mean  0.0)  (interval  0.5)) 

(declaie  (type  float  mean  interval)) 
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(♦when  fan-outp!! 

(♦set  WM  (random-float!! 

(the  float-pvar  (!!  mean)) 

(the  float-pvar  (!!  interval)))))) 


; ; ;  EOF 
#+:ccl 

(format  t  "'*/A"(^  Make  Iet\‘*  loaded") 

9 


;;;  -*-  Mode;  LISP;  Syntax:  Common-lisp;  Package:  vLISP;  Base;  10  -♦- 
(in-package  ’*lisp) 


Etienne  Deprit 

laval  Research  Lab,  Code  8242 


;  lettalk  Implementation 
;  CM  Ret  Access 


Slab  Access 


;  GE'^-SLAB-PVAR  returns  an  array  containing  the  values  of  PVAR 
i  for  the  slab  with  id  SLAB-10  in  BET. 

(defun  get-slab-pvax  (net  slab-no  pvar) 

(let  ((slab  (get-slab  net  slab-no))) 

(•all 

(•let  (mail-box!!) 

(♦when  (and!!  unitp!!  (=!!  slab-no!!  (slab-no!!  slab))) 

(♦pset  ; no-collisions  pvar  mail-box!!  (enumerate!!)) 
(pvar-to-array  mail-box!!  (meOte-array  (slab-size  slab)) 

: cube-address-end  (count-css)))))) ) 

;  GET-SLAB-X  returns  an  array  containing  the  values  of  X!! 

;  for  the  slab  with  id  SLAB-IO  in  BET. 

(defmacro  get-slab-X!!  (net  slab-no) 

‘ (get-slab-pvar  ,net  , slab-no  X!!)) 

;  GET-BET-OUTPUT  returns  an  array  containing  the  output  values  of  BET 

(defmacro  get-net-output  (net) 

‘ (get-slab-X ! !  ,net  (net-output-slab-no  ,net))) 


Bundle  Access 


;  GET-BUBDLE-PVAR  returns  eirray  containing  the  values  of  PVAR 
;  for  the  bundle  with  id  BUBDLE-BO  in  BET. 

(defun  get-bundle-pvar  (net  bundle-no  pvar) 

(let  ((bundle  (get-bundle  net  bundle-no))) 

(•all 

(♦let  (mail-box!!) 
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(♦when  (and!!  fan-outp! !  (*! !  bundle-no!!  (bundle-no!!  bundle))) 
(♦pset  ino-collisions  pwar  mail-box!!  (enumerate!!)) 
(pvar-to-arraj  mall-box!!  (laahe-array  (bundle-size  bundle)) 

: cube-address-end  (count-css) ))) ))) 

;  GET-BUIDLE-V  returns  an  array  containing  the  values  of  ¥! ! 

;  for  the  bundle  with  id  BUIDLE-IO  in  lET. 

(defmacro  get -bundle -V ! !  (net  bundle-no) 

‘ (get-bundle-pvar  »net  , bundle-no  H!!)) 

; ; ;  EOF 

#+:ccl 

(format  t  let  AccessV"  loaded*') 


-♦-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  •LISP;  Base:  10  -•- 
(in-package  ’elisp) 


Etienne  Deprit 

laval  Research  Lab,  Code  8242 

lettaXk  Implementation 
Training  Sets 


;  Training  Examplar 

(defstruct  (examplar 

(.type  list)) 

input-pvar 
input-vec 
target -pvar 
target-vec) 

;  Training  Set 

(defstruct  (training-set 

(.'type  list)) 

type  ;  HAPPIiG-SET  or  MEHORY-SET 

name 

examplars)  ;  list  of  examplars 

;  GET-EXAHPLAR  returns  the  examplar  with  id  EXAMPLAR  -10  in  TRAIIIIG-SET. 

(defmacro  get-examplar  (training-set  exanrplar-no) 

^ (nth  ,examplar-no  (training-set-examplars  , training-set) ) ) 

;  CH-LOAD-TRAIIIIG-PAIR  loads  the  IIPUT/TARGET  training  vectors  into  the 
;  COHTIBUQUS-MAPPIIG  net  structure  on  the  CM  2Lnd  returns  an  examplar 
;  containing  the  IIPUT  and  TARGET  vectors.  The  pvars  corresponding 
;  to  the  training  pair  are  marked  with  the  given  SET-IAME  and  PAIR-IO. 

(defun  cm-load-training-pair  (set-name  pair-no  input  target) 

(•all 

(let  ((input!*  (allocate*!  nil 

(format  nil  ""a-'a-I**  set-name  pair-no) 
’float-pvar) ) 
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(target!!  (allocate!!  nil 

(format  nil  ""a-'a-T"  set-name  pair-no) 
’float-pear))) 

(*let  (mail-box!!) 

(declare  (type  float-pear  mail-box!!)) 

(array-to-pear  input  mail-box!!  rcube-address-end  (length  input)) 

(*Bhen  inputp! ! 

(*set  (the  float-pear  input!!) 

(pref!!  mail-box!!  unit-no!!  '.collision-mode  ino-collisions))) 
(array-to-pear  target  mail-box!!  : cube-address-end  (length  target)) 

( eehen  outputp !  ! 

(*set  (the  float-pear  target!!) 

(pref!!  mail-box!!  unit-no!!  : collision-mode  rno-collisions) ) ) ) 
(list  input!!  input  target!!  target)))) 

;  CM-LOAD-MAPPIIG-SET  loads  the  TRAHIIG-PAIRS  labeled  SET-IAME  into  the 
;  COITIIUOUS-HAPPIIG  net  structure  on  the  CM  and  returns  the  resulting 
;  training  set.  TRAIIIIG-PAIRS  must  be  a  list  of  input/target  sector  lists. 

(defun  cm-load-mapping-set  (set-name  ttaining-pairs) 

(let  ((pair-no  -1)) 

(list  ’mapping-set  set-name 

(mapcar  #’ (lambda  (pair) 

(cm-load-training-pair  set-name 

(incf  pair-no) 

(first  pair) 

(second  pair))) 

training-pairs ) ) ) ) 

;  CM-LOAD-MEHORY-IIPUT  loads  the  IIPUT  sector  into  the  COITIIUOUS-HAPPIIG 
;  net  structure  on  the  CM  and  returns  an  examplar.  The  pear  corresponding 
;  to  the  IIPUT  sector  is  marked  uith  the  gieen  SET-IAME  and  IIPUT-IO. 

(defun  cm-load-memory- input  (set-name  input-no  input) 

(•all 

(lot  ((input!!  (allocate!!  nil 

(format  nil  "'a-"a-I"  set-name  input-no) 
’float-pear))) 

(•let  (mail-box!!) 

(declare  (type  float-pear  mail-box!!)) 

(array-to-pear  input  mail-box!!  ; cube-address-end  (length  input)) 

(•ehen  inputp! ! 

(•set  (the  float-pear  input!!) 

(pref!!  mail-box!!  unit-no!!  : collision-mode  :no-collisions) )) ) 
(list  input!!  input  input!!  input)))) 

;  CH-LOAD-HEMORY-SET  loads  the  TRAIIIIG-LIST  labeled  SET-IAME  into  the 
;  COITIIOUS-MAPPIIG  net  structure  on  the  CM  and  returns  the  resulting 
;  training  set.  The  TRAIIIIG-LIST  must  be  a  list  of  input  sectors. 

(defun  cm-load-momory-sot  (set-name  training-set) 

(let  ((input -no  -1)) 

(list  ’memory-set  set-name 

(mapcar  *’ (lambda  (input) 

(cm- load-memory-input  set-name 

(incf  input -no) 
input)) 

training-set)))) 

;  CH-UILOAD-TRAIIIIG-SET  unloads  TRAIIIIG-SET  from  the  COITIIUOUS-HAPPIIG  or 
;  ASSOCIATIVE-MEMORY  net  structure  on  the  CM.  The  pears  in  the  TRAIIIIG-SET 
;  array  are  deallocated  and  should  no  longer  be  accessed. 

(defun  unload-training-set  (training-set) 

(let  ((type  (training-set-type  training-set))) 

(map  nil 

•’(lambda  (examplar) 

(•deallocate  (examplar- input-pear  examplar)) 

(if  (eq  type  ’mapping-set) 
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(•d«allocat«  (axanplar-targat^p^ar  axamplar)) )) 
(training-aat-axamplars  training-sat)))) 

;  PRIMT-TRAIIIIG-SET  prints  the  TRAIIIIG-SET*s  input/target  or 
;  input  vectors  for  a  HAPPIIG-SET  or  HEHORY-SET,  respectively. 

(defun  print-training-set  (training-set ) 

(let  ((type  (training-set-type  training-set))) 

(format  t  "*2%*a:  “a”  type  (training-set-name  training-set)) 

(map  nil 

t* (lambda  (examplar) 

(format  t  ”)  (print-vec  (examplar- input-vec  exemplar)) 

(when  (eq  type  ’mapping-set) 

(format  t  '*  t:  ")  (print-vec  (examplar-target-vec  examplar)))) 
(training-set-examplars  training-set) ))) 

; i .  KUF 
i>:cr:l 

(format  t  "*'*/,\"Training  Seta\"  loaded") 


Node:  LISP;  Syntax:  Common-l isp;  Package;  •LISP;  Base:  10  -•- 
(in-package  ’•lisp) 


Etienne  Deprit 

■aval  Research  Lab,  Code  8242 


Heltalk  Implementation 
let  Learning 


,  DKHIJG-LHARIIIG  sets  toggles  the  :IKT-DEHUO  flag  in  the  features  list. 

(defun  debug- 1  earn ing  (Aoptional  (debug*on  t)) 

(  i  f  «l«bug“on 

(pushnew  :net-debug  •features^) 

(setf  ♦features*  (delete  :net-debug  ♦features*)))) 

;  Sf:alar  LOGISTIC  function 

(rtofiin  logistic  (x) 

(/  ( I ♦  (eip  (-  x))))) 

.  Pnrallol  LOGISTIC  ftiiu:tion 

(dnfma«ro  logistic:’'  (»f*) 

‘(/'!  {t.h«  s  i  ng  1  o  -  f  i  ortl  -  pva  I  (I***  («xp' !  (-?’  ,iM)))))) 

S'  alar  I.OGIfiTIC  d«rivnt.iv« 

( d«*  f  un  dl.og  I  nt  i  (  ( i ) 

(l«l  ((logistic  (ioginlic  i))) 

(•  logintic  (-  1  logistic)))) 

.  Paralloi  l.0GI!m<*  rlorivntivn 

('leffnacro  «II.og  i  si  i  r;  •  '  (x‘') 

(lot  (  (  I  og  i  s  I  If.  ’  '  (gnnsym))) 


NRL  REPORT  9167 


'(•lot  ((.logistic!!  (logistic!!  ,x!!))) 
(declare  (type  float-pvar  .logistic!!)) 

(*!!  .logistic!!  (-!!  (!!  1)  .logistic!!)))) 

) 

;  •lORM  of  prar 

(defmacro  *110x10  (x!!) 

‘(sqrt  (*sum  (*!!  .x!!  .x!!)))) 


Feed-forward 


;  FFED-FORWARD  computes  a  single  feed-forward  cycle  of  lET  with  the  given  IIPUT!!. 
;  If  lET  is  an  ASSOCIATIVE-MEMORY  net  and  LATCHED-P  is  T.  than  FEED-FORWARD 
;  operates  on  the  master  network  rather  than  the  slave  network. 

(defun  feed-forward  (net  input!!  tkoy  latched-p) 

(•all 

(•when  netp! ! 

(•when  unitp!! 

(•set  I! !  (! !  0.0) 

1 ! !  (! !  0.5) 
dl!!  (!!  O.S)) 

(•when  inputp! ! 

(if  (memory-netp  net) 

(•set  X!!  (the  float-pvar  input!!)) 

(•set  I!!  (the  float-pvar  input!!)))) 

(•set  Z! !  I! !)) 

(•set  Z! !  (scan!!  Z! !  ’copy!!  ;segmant-pvar  forward-fan-out-seg! ! )) 

(do  0 

((•when  unitp!!  (*and  (<!!  (abs!!  dl!!)  epsilon-x! ! ) )) ) 

(dotimes  (i  (net-x-iterations  net)) 

*+ .net-debug 
(progn 

(format-pvars  (U!!  LogO! !  dl!!  X!!  Z!!)) 

(format  t  ""'/.Hit  any  key  to  continue:  ")  (read-char)) 

(•when  fan-outp!! 

(•set  0! !  (•! !  W! !  Z! !)) 

(*pset  : no-collisions  U! !  U!!  to-addr!!)) 

(•when  unitp ! ! 

(•set  U! !  (! !  0.0))) 

(•set  U!!  (scan!!  U!!  ’+!!  ;segmont-pvar  forward-fan-in-seg! ! )) 

(•when  unitp! ! 

(•set  LogO!!  (logistic!!  0!!) 

dl!!  (+!!  (•!!  a!!  (- ! !  X!!))  (•!!  b!!  LogO!!)  I!!) 

X! !  (+! !  I! !  dX! !) 

Z! !  X! !) 

(if  latched-p 

(•when  inputp!! 

(•set  Z!!  (the  float-pvar  input!!))))) 

(•set  Z!!  (scan!!  Z!!  ’copy!!  ;segment-pvar  forward-fan-out-seg!!)) 

)) 

))) 


;  Back-Propagate 


;  BACK-PROPAGATE  computes  a  single  back-propagation  cycle  of  lET  with  the  given  TARGET! ! . 

(defun  back-propagate  (net  target!!) 

(•all 

(•when  netp! ! 

(•when  unitp! ! 
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(•if  outputp!! 

(•set  J!!  (- ! !  (the  float-pveir  target!!)  X!!)) 

(•set  J! !  (! !  0.0)))) 

(•when  (or!!  unitp! !  fan-outp!!) 

(•set  Y! !  (! !  0.0)) 

(•set  dY! !  (! !  0.5))) 

(do  () 

((•when  unitp! !  (eand  (<!!  (abs!!  dY!!)  epsilon-j! !)))) 

(dotimes  (i  (net-y-iterations  net)) 

•+  ixiet'debug 
(progn 

(foraat-pvars  (LogU!!  V!!  dY!*  YlD) 

(format  t  "‘y.Hit  any  key  to  continue:  ")  (read-char)) 

(♦when  fan-outp!! 

(♦set  V! !  (♦! !  W! !  Y! !))) 

(♦when  unitp! ! 

(♦set  V!!  (!!  0.0))) 

(♦set  V!!  (scan!!  V!!  ’+!! 

:  segment -pwar  backward-fein-out-seg! ! 
idirection  :backuard)) 

(•when  unitp ! ! 

(if  (memory-netp  net) 

(♦when  inputp!! 

(•set  V! !  (! !  0.0)))) 

(♦set  dY!!  (+ ! !  (•!!  a!!  (-!!  Y!!)) 

(♦!!  b!!  LogU!!  (-!!  (!!  1.0)  LogU!!) 
(+! !  V! !  J! !))) 

Y!  !  (  +  ! !  Y! !  dY! !))) 

(•set  Y!!  (scan!!  Y!!  ’copy!! 

:dire’-tion  :  backward 
: segment-pvar  backward-fan-in-seg! <)) 

•+ : ♦lisp-simulator 
(progn  (•when  fan-inp!! 

(•pset  :no-collision8  Y!!  V!!  from-addr! !)) 
(•when  fan-outp!! 

(•set  Y! !  V! !))) 

#+ :^lisp-hardware 
(♦when  fan-inp! ! 

(♦poet  :no-colli8ion8  Y!!  Y!!  from-addr!!)) 

)) 

))) 


Gradient  Update 


:  GRADIEHT-UPDATE  increments  the  current  weight-space  gradient. 

(defun  gradient-update  () 

(•when  fan-outp!! 

(♦set  dW! ! 

(+! !  dW! !  (•! !  Y! !  Z! !))))) 


;  Weight  Update 

;  WEIGHT-UPDATE  updates  the  connection  weights  using  the  current  and  last  gradients. 

(defun  weight-update  () 

(•when  fan-outp!! 

(•set  W! !  (+! !  W! ! 

(•! !  eta! !  dW! !) 

(•! !  alpha! !  dWold! !)) 
dWold!!  dW!!))) 
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let  Training 


;  STEEPEST-DESCEIT  perfoms  a  true  staepest-descent  adjustment  of  the  connection  eeights 
;  for  the  Input/target  pairs  in  TRAIIIIG-SET.  STEEPEST-DESCEIT  returns  T  or  IIL 
;  indicating  if  TRAIIIIG-SET  has  been  learned  sithin  the  seight  update  criterion  and 
;  the  current  target  error.  If  provided,  the  PRIIT-IET-IO  function  is  called  to  report 
;  the  net’s  input  and  output. 

(defun  steepest-descent  (net  training-set  they  print-net-io) 

(let  (deamed-p  t) 

(target-error  0.0)) 

(•all 

(•when  fan-outp!! 

(•set  dW!  !  (!  !  0.0))) 

(dolist  (ezamplar  ( training-set -ezamplars  training-set)) 

(feed-forward  net  (ezamplar- input -pwar  ezamplar)  :latched-p  (memory-netp  net)) 
(baclc-propagate  net  (ezamplar-target-pvar  ezamplar)) 

(•when  outputp!  ! 

(setf  learned-p 

(^Lnd  learned-p 

(•and  (<!!  (abs!!  J!!)  epsilon-w! !)))) 

(incf  target-error  (enorm  J!!))) 

(if  print-net-io 

(funcall  print-net-io  (ezamplar-input-wec  ezamplar)  (get-net-output  net))) 
(gradient-update) ) 

(weight-update)) 

(values  leamed-p  target-error)) 

) 

:  TRill-IET  trains  lET  using  the  given  TRAIIIIG-SET.  If  specified,  PRIIT-TRAIIIIG-SET 
;  is  called  to  print  the  current  TRAIIIIG-SET.  In  addition,  PRIIT-IET-IO  may  be  used 
;  to  report  the  net’s  input  and  output  each  PRIIT-IITERVAL  iterations. 

(defun  train-net  (net  training-set  Alley  print-training-set  print -interval  print-net-io) 
(format  t  ""2'/.Iet  Training"%") 

(print-net  net  t  nil  ;verbo8e-p  t) 

(if  print-training-set 

(funcall  print-training-set  training-set)) 

(•all 

(•when  fan-outp! ! 

(•set  dlold! !  (! !  0.0)))) 

(do  ((iteration  0  (1+  iteration)) 

(learned-p  nil) 
target-error 

(print-net-io-p  print -interval 

(and  print-interval 

(zerop  (mod  (1+  iteration)  print-interval))))) 


((or  learned-p 

(and  (net-maz-updates  net) 

(=  iteration  (net-maz-updates  net)))) 

(format  t  "■2XTraining  sot  "tCnot  ';"]leamed  after  "a  iteration"  ;•' [s' s']  . 

leamed-p  iteration) 

(when  (and  print-interval  print-net-io) 

(map  nil  t’ (lambda  (ezamplar) 

(feed-forward  net  (ezamplar-input-pvar  ezamplar)) 

(funcall  print-net-io 

(ezamplar-input-vec  ezamplar) 

(get-net-output  net))) 
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(training-set-axanplars  training-set)) 

(fonaat  t  ""XError  “  "a"  target-error))) 

(if  print-net-io-p 

(format  t  ""2Xlteration  "a"  iteration)) 

(mult iple-ealue-setf 

(learned-p  target-error) 

(steepest-descent  net 

training-set 

:print-net-io  (if  print-net-io-p  print-net-io) ) ) 


(if  print-nat-io-p 

(format  t  "'XError  =  "a"  target -error)) 

) 

(values) ) 

; ; ;  EOF 
#+:ccl 

(format  t  "■X\"Iet  LearningV"  loaded") 


;;;  Mode:  LISP;  Syntax:  Common-lisp;  Package:  «LISP;  Base:  10  -*- 
(in-package  'elisp) 


Etienne  Deprit 

laval  Research  Lab,  Code  8242 


;  lettalk  Implementation 
;  OR  Test  lets 


lOR  Continuous  Happing  let 


(def -mapping-net  or-aiapping-net 

•slabs  ’(2111) 

: input -slab-no  0 
: output-slab-no  2 
: bundles  ’((10  100) 
(2  0  100) 
(2  1  100) 
(1  3  100) 
(2  3  100) 
(3  3  100) 
) 

) 


(defvar  • ior-mapping-pairs*) 

(self  »ior-mapping-pair8* 

(list-to-array-pairs  ’(((0.0 
((0.0 
((1 .0 
((1 .0 


0.0)  (0.0)) 
1.0)  (1.0)) 
0.0)  (1.0)) 
1.0)  (1.0))))) 


(defvar  •ior-mapping-aet») 
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(satf  *ior-mapping~set* 

(cm-load-mapping-sat  ’ ior-mapping-set  •ior-mapping-paira*) ) 

(train-net  or-mapping-net 

♦ior-mapping-set* 

:print-trnining-set  f ’print-training-aet 
:print-interTal  10 
;print-net-io  #'print-io-»eca) 


XOR  issociative  Memory  let 


'  ;-.'*-meraory-net  or-memory-net 
: slabs  ’(31) 

: input -slab-no  0 
ibundles  ’((0  0  100) 
(0  1  100) 
(1  1  100) 
) 

:opailon-B  0.05 

) 


(defvar  *xor-memory- 
(setf  *xor-mamory-list* 

(list-to-array  ’((0.0  0. 

(0.0  1. 
(1.0  0. 
(1.0  1. 


0.0) 

1.0) 

1.0) 

0.0)))) 


(defvar  *xor-memory-set*) 

(setf  »ior-memory-set* 

(cm-load-memory-set  ’xor-memory-set  •xor-memory-list*) ) 

(train-net  or-memory-net 

♦xor-memory-set* 

.print-tr^ining-set  • ’print-training-sat 
:print-interval  20 
:print-net-io  #’print-io-vecs) 

; ; ;  EOF 
•+ : ccl 

(format  t  "'%\"Te8t  Iets\"  loaded") 


;;;  -♦-  Mode:  LISP;  Syntax:  Common-lisp;  Package;  *LISP;  Base:  10  -♦- 
(in-package  ’*lisp) 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 

;;;  let talk  Implementation 

;  ; ;  Time  lets 

;  CH-TIHE-ilD-PRIlT  times  the  execution  of  FORM  and  reports  the  timing  statistics. 
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(defmacro  cm-tuie-and-print  (form) 

(let  ((elapsed-tine  (gensym)) 

(cm-tiae  (gensym)) 

(percent  (gensym)  ) } 

‘  (nmltiple-Talue-bind  ( ,elapsed-tiae  , cm-tiae  .percent) 

(cm:time  .form  :retnm-8tatistics-only-p  t) 

(print-cm-timing  ’.(if  (listp  form)  (first  form)  form) 

.elapsed-time 

.cm-time 

.percent)))) 

;  PRIIT-CM-TIMIIG  prints  the  FE  ELAPSED-TIHE.  CH-TIME  and  CM  usage  PERCEIT 
;  statistics  for  the  given  OPERATIOI. 

(defun  print-cm-timing  (operation  elapsed-time  ca-time  percent) 

(format  t  "'y."a:  '7.3f  secs  elapsed  time.  ~7 ,3f  secs  CM  time  ('4,lfy,)“ 
operation  elapsed-time  cm-time  percent)) 


Mapping  let  Timings 


;  TIME-MAPPUG-IET  compiles  timing  statistics  for  the  COfTIlUOUS-MAPPIlG  test  net 
;  up  to  MAX-1.  IlCREMEIT  controls  granularity  of  the  increment  in  net  size. 

(defun  time-mapping-net  (max-n  they  (increment  1)) 

(cmi: ; calibrate-cm-timer) 

(let  (mapping-net 
mapping-set) 

(do  ((n  1  (+  increment  n))) 

((>  n  max-n)) 

(setf  mapping-net 

(fe-make-net  ’mapping-net 

; continuous -mapping 
(list  (•  4  n)  (•  2  n)  n  1) 

0 

2 

’((1  0  100) 

(2  0  100) 

(2  1  100) 

(1  3  100) 

(2  3  100) 

(3  3  100) 

) 

)) 

(format  t  "■3%e»»  1  =  "a  *♦*"  n) 

(format  t  ""WCapping  net:  "a  units,  "a  connections  ->  *a  processors" 

(net-no-units  mapping-net) 

(net-no-connections  mapping-net) 

(net-no-processors  mapping-net)) 

(cm-net-cold-boot  mapping-net) 

(format  t  ”"V,VP  ratio  =  "a"  cm: *virtual-to-physical-processor-ratio») 

(cm-t ime-and-print 

(cm-make-net  mapping-net)) 

(setf  mapping-set 

(cm-load-mapping-set  ’mapping-set 
(list 

(list  (make-array  (♦  4  n)  : initial-element  1.0) 
(make-array  n  : initial-element  1.0))))) 

(cm-t ime-and-print 

(feed-forward  mapping-net  (examplar-input-pvar  (get-examplar  mapping-set  0)))) 
(cm-t ime-and-print 

(back-propagate  mapping-net  (eiamplar-target-pvar  (get-examplar  mapping-set  0)))) 

(if  (and  (=  n  1)  (/=  increment  1))  (decf  n)) 

))) 

;  TIHE-HEHORY-IET  compiles  timing  statistics  for  the  ASSOCIATIVE-MEMORY  test  net 
;  up  to  MAX-1.  IlCREMEIT  controls  granularity  of  the  increment  in  net  size. 
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(dafun  tima-Ba>orj-nat  (aax-n  tke}  (incremant  1)) 

(cai : : calibrata-aa-tiBar) 

(lat  (BeBorj-nat 
BeBory-aat) 

(do  ((n  1  (+  increBant  n))) 

(On  max-n)) 

(setf  BeBory-nat 

(ta-Baka-nat  ’Baaory-nat 

: asaociatlve-BaBory 
(Hat  (a  8  n)  n) 

0 

0 

>((1  0  25) 

(0  1  25) 

) 

)) 

(format  t  "'SXaa*  I  =  *a  **•"  n) 

(format  t  '''yjtamory  nat :  *a  units,  "a  connactions  ->  'a  processors" 

(net-no-units  memory-net) 

(net-no-connections  Bemory-net) 

(net-no-processors  memory-net)) 

(cm-net-cold-boot  memory-net) 

(format  t  "■y,VP  ratio  =  "a"  cm;»»irtual-to-physical-processor-ratio«) 

(cm-t  ime-and-print 

(cm-make-net  memory-net)) 

(setf  memory-set 

(cm-load-memory-set  ’memory-set 

(list  (make-array  (*  8  n)  : initial-element  1.0)))) 

(cm-t ime-and-print 

(feed-f orsard  memory-net  (examplar-input-p»ar  (get-examplar  memory-set  0)))) 

( cm-t ime - and-pr int 

(back-propagate  memory-net  (examplar-input-pvar  (get-examplar  memory-set  0)))) 

(if  (and  (=  n  1)  (/=  increment  1))  (decf  n)) 

))) 

; ; ;  EOF 
#+ : ccl 

(format  t  "*y.\"Tima  letsV'  loaded") 
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♦LISP  CODE  FOR  TOMBOULIAN  IMPLEMENTATION 


;;;  Mode;  LISP;  Syntax:  Common-lisp;  Package:  ‘LISP;  Base:  10 
(in-package  ’‘lisp) 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 


Tomboolian  Implementation 
Pxar  Types 


Mil-IIT-PViR 

unsigned 

byte 

CUBE-4DDRESS-PViR 

unsigned 

byte 

SLAB-RQ-PViR 

unsigned 

byte 

UIIT-IO-PVAR 

unsigned 

byte 

BUIDLE-IO-PVAR 

unsigned 

byte 

COIIECTIOI-IO-PVAR 

unsigned 

byte 

[0  ,  2*t6-l] 

[0  ,  *log-niimber-of-processors-limit»] 

Co  ,  2-16-1] 

[0  ,  2*16-1] 

[0  ,  2*16-1] 

[0  .  2*32-1] 


;  Pvar  type  field  sizes 

(delvax  *cm-max-^nt*) 

(defxar  eslab-no-size*) 

(defvar  *unit-no-size*) 

(defvar  *bnndle-no-size*) 

(defvar  ‘connection-no-sizee) 

(defrar  *cm-single-float-size*  32)  ;  IEEE  single-float  size,  VEITIEK  chips 

;  Set  field  sizes  in  compiler’s  enrironment 


(exal-shen  (compile  load  exal) 
(setf  *cm-maz-int*  (ezpt  2  16)) 
(setf  eslab-no-size*  16) 

(setf  *nnit-no-size*  16) 

(setf  *bundle-no-size*  16) 

(setf  econnection-no-size*  32) 

) 


;  Define 
(deftype 

(deftype 

(deftype 

(deftype 


pear  types 

max-int-p»ar  ()  ’(pear  (unsigned-byte 

t.(l+  (ceiling  (log  *cm-mai-int*  2)))))) 

cube-address-pvar  ()  ’(pear  (unsigned-byte 

•log-number-of-processors-limit*))) 

slab-no-pear  ()  ’(pear  (unsigned-byte  #.*slab-no-size*))) 

unit-no-pear  ()  ’(pear  (unsigned-byte  •.eunit-no-size*))) 
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(deftype  bniidle-no-p*ar  ()  ’{prar  (unsigned-byte  t.ebundle-no-size*))) 

(deftype  connection-no-pear  ()  ’(pear  (unsigned-byte  t.econnection-no-size*))) 

;  When  using  simulator,  add  nee  pear  type  symbols 

i+ : elisp-simulator 
(progn 

(pushnes  ’max-int-pear  ♦*lisp-exported-type-symbols*) 

(pushneu  ’cube-address-pear  eelisp-exported-type-symbols*) 

(pushnes  ’slab-no-pear  **lisp-exportod-typa-aymbola*) 

(pushnes  ’unit-no-pear  **li8p-axported-type-8ymbols*) 

(.pushnes  ’bundle-no-pear  **li8p-exportod-type-8yiiibol8») 
pushnes  ’connection-no-pear  eelisp-exported-type-symbols*) 

) 

; ; ;  EOF 
#+ : ccl 

(format  t  "■’/A''Pear  TypesN"  loaded") 


;;;  -»-  Hode :  LISP;  Syntax:  Common-lisp;  Package;  «LISP;  Base:  10  -*- 
(in-package  '*lisp) 


Etienne  Deprit 

■aeal  Research  Lab,  Code  8242 


Tomboulian  Implementation 
Ut  ilities 


;  COUIT-CSS  returns  the  number  of  processors  in  the  currently  selected  set. 

(defon  count-css  () 

(♦sum  ( !  !  1))) 

;  HAX-liT!!  returns  a  field  pear  containing  ♦CM-HAI-IIT* . 

(defmacro  max-int!!  () 

’(the  max-int-pear  (!!  *cm-max-inte) ) ) 

;  RAIDOM-FLOAT ! !  returns  a  random  float  pear  evenly  distributed  in  the  interval 
;  [mean-interval  ,  mean+interval]  in  each  processor. 

#- : •lisp-simulator 

(♦proclaim  ’(ftype  (function  (t)  (pvar  single-float))  random-float!!)) 

(♦defun  random-float!!  (mean!!  interval!!) 

(declare  (type  float-pvar  mean!!  interval!!)) 

(♦let  (temp! ! ) 

(declare  (type  float-pvar  temp!!)) 

(♦set  temp! ! 

(+ ! !  mean! ! 

(♦  !  '  interval !  ! 

(if!!  (=!!  (random!!  (!!  2))  (!!  1)) 

(!!  1.0) 

(!!  -1.0)) 
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teiq>!  ! ) ) 


(/!!  (randoD! !  (max-int ! ! )) 
(aax-litt!  !))))) 


;  FORNAT-PVARS  pretty  prints  the  given  list  of  PVARS.  Additional  keysord  argnaents 
;  sill  bo  passed  in  to  PRETTY-PRIIT-PVAR. 

(defaiacro  foruat-pvars  (pvars  trest  keys  tkey  talloB-other-keys) 

‘ (progn 

,C(mapcan  >’ (lambda  (pvar) 

‘((format  t  "‘X'a"  (pvar-naae  .pvar))  (ppp  ,pvar  ,Ckeys))} 
pvars))) 


;  EIUHERATh.  ii'turns  the  list  (0,1,.. I). 

(defun  enumerate  (n) 

(let  (1) 

(dotimes  (i  n) 

(push  i  1)) 

(nre verse  1))) 


;  MULTIPLE-VALUE-SETF  sets  the  locations  referenced  by  ACCESSOR-FORKS 
;  to  the  multiple  values  returned  by  VALUES-FORK. 

(defmacro  mult iple-value-setf  (accosor-f orms  values-form) 

(let  ((values-list  (gensym)) 

(i  -D) 

‘dot  ((, values-list  (multiple-value-list  , values-form) ) ) 

(setf  ,fl(mapcan  (’(lambda  (accessor-form) 

‘ ( ,accessor-form  (nth  ,(incf  i)  , values-list))) 
accesor-f orms) ) ) ) ) 

;  PRIiT-VEC  prints  the  array  VEC  on  STREAM  sith  the  given  ELQIEITS-PER-LIBE . 

;  Each  element  is  printed  using  ELEHEIT-FORMAT,  and  each  line  of  output  is 
;  preceeded  by  lEW-LIlE-FORKAT. 

(defun  print-vec  (vec  (optional  (stream  t) 

(key  elements-per-line  (element-format  ""s  ")  (neu-line-format  "'’/,")) 
(dotimes  (i  (length  vec)) 

(if  (and  elements-per-line 

(zeroD  (mod  i  elements-per-line))) 

(format  stream  nee-line-format)) 

(format  stream  element-format  (aref  vec  i))) 

(values) ) 


;  PRIIT-IO-VECS  priiits  the  IIPUT  and  OUTPUT  vectors. 

(defun  print-io-vocs  (input  output) 

(format  t  "'%i:  ")  (print-vec  input) 

(format  t  "  o:  ")  (print-vec  output)) 

;  LIST-TO-ARRAY-PAIRS  coerces  the  list  of  LIST-PAIRS  into  a  list  of  array  pairs. 

(lcf.*n  list-to-array-pairs  (list-pairs) 

(let  (input  target) 

(map  ’list 

(’(lambda  (pair) 

(setf  input  (first  pair) 

target  (second  pair)) 

(list 

(make-array  (length  input)  : initial-contents  input) 

(make-array  (length  target)  : initial-contents  target))) 
list-pairs))) 

;  LIST-TO-ARRAY  coerces  the  list  of  lists  into  a  list  of  arrays. 

(defun  list-to-array  (list) 

(map  ’list 

(’(lambda  (sub-list) 
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(maXe-array  (length  sub-list)  : initial-contents  sub-list)) 
list) ) 


; EOF 
#+ : ccl 

(format  t  *'"yA"Utilties\'*  loaded") 


;;  Node:  LISP;  Syntax:  Conunon-lisp ;  Package:  eLISP;  Base:  10 

(in-package  ^•lisp) 


Etienne  Deprit 

Baval  Research  Lab»  Code  8242 


Tomboul ian  Implementat ion 
■-Dimensional  Grid 


:  Grid  parameters 
(defvar  ♦max-hops*) 

(defvar  *max-hops-size*) 
(defvar  *grid-dim-size*) 
(defvar  •grid-center*) 

(defvar  *max-hops-to-center*) 


;  max  hops  in  grid 
;  max  hops  field  size 
;  grid  dimension  field  size 
;  addr  of  grid  center 
;  max  hops  to  grid  center 


;  Define  grid  pvar  types 

;  GRID-DIMEiSIOi-PVAR  [O.max  dimension) 

;  GRID-OFFSET-PVAR  -1,0, +1 

,  GRID-DISTAilCE-PVAR  [0,max  hops] 

(deftype  gr id-dimension-pvair  ()  ’(pvar  (unsigned-byte  *grid-dim-size*) ) ) 
(deftype  grid-offset-pvar  ()  ’(pvar  (signed-byte  2))) 

(deftype  grid-distance-pvar  ()  ’(pvar  (unsigned-byte  ♦max-hops-size*))) 

,  Vhen  using  simulator,  add  nee  pv^u:  type  symbols 

i+ : •lisp-simulator 
(progn 

(pus Knew  ’grid- dimens  ion -pvar  •♦lisp-exported- type-symbols*) 

(pus Knew  ’ grid-offset-pvar  ••lisp- exported- type-symbols*) 

(pusKnee  ’grid-distemce-pvar  ••lisp-exported-type-symbols*) 

) 

,  HAX-HOPS  returns  the  maximum  number  of  hops  for  the  given  GRID-DIHEBSIONS . 

(defun  max-hops  (grid-dimensions) 

(-  (reduce  •’+  grid-dimensions) 

(length  grid-dimensions))) 

;  GRID-CEBTER  returns  the  center  of  GRID-DIMEiSIOIS . 
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(def un  grid-center  (grid-dimensions) 

(mapcar  (lambda  (n) 

(truncate  n  2)) 
grid-dimensions) ) 

;  DIHEHSIQI-IO * !  returns  a  grid-dimension-pvar  containing  DIN  number. 

(defmacro  dimension-no M  (dim) 

‘(the  grid-dimension-pvar  (!!  ,dim))) 

;  GRID-CEHTER! •  returns  a  grid-distance-pvar  containing  the  grid  center  along  DIM. 

(defmacro  grid-center! !  (dim) 

‘(the  grid-distance-pvar  (!!  (nth  ,dim  *grid-center*)))) 

;  IHIT-H-DIMEHSIOHAL-GRID  initializes  the  n-dimensional-grid  parameters. 

(defun  init-n-dimensional-grid  () 

(setf  •max -hops*  (max-hops  ♦current-cm-conf igurat ion*) 

*max-hops*size*  (ceiling  (log  *max-hops*  2)) 

*gTid-dim-si2e*  (ceiling  (log  (apply  t^max  *current-cm-conf igurat ion*)  2)) 
*grid-center*  (grid-center  *current-cm-conXiguration*) 

*max-hops-to-center*  (reduce  t*+  *grid-cen\.er*) 

*ppp-def ault-mode*  :grid)) 

;  Reset  B-dimensional-gr id  parameters  after  *C0LD-B00T. 

#+ : *lisp-hardware 

(add-initialization  "Init  I  Dimensional  Grid" 

^ ( init-I-dimensional-grid) 

* vaft er- •cold-boo t -ini t ializations*) 


•+ : *lisp-simulator 

(add-initialization  :name-of-form  ‘Tnit  I  Dimensional  Grid" 

: f orm  ^ ( init-l-dimensional-grid) 

;  variable  '•after-*col<i-boot-initializations*) 

;  *C0LD-B00T  CM  to  current  grid  dimensions. 

(*cold-boot) 

; ; :  EOF 

#+ : ccl 

(format  t  Dimensional  Grid\**  loaded") 


;;;  -*-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  *LISP;  Base:  10  -*- 
Cin-package  ’*lisp) 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 

Toraboulian  Implementation 
Processor  Allocation 
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;  CN  Dimensions 


;  ^CM-DINEISIOIS*  is  a  list  of  CN  configurations .  Each  configuration  is  a  list 
;  of  the  total  number  of  processors  and  the  corresponding  CN  dimensions. 

(defvar  ecm-dimensionse 

(mapcar  (lambda  (dims) 

(list  (reduce  t’e  dims)  dims)) 

•+ : «li8p*hardeare 


(( 

64 

128) 

( 

128 

128) 

( 

128 

256) 

( 

256 

256) 

( 

256 

512) 

( 

512 

512) 

( 

512 

1024) 

(1024 

1024)) 

t+ : ^lisp'simulat or 
»((4  4) 

(6  4) 

(6  6) 

(8  6) 

(8  8)) 

)) 


;  CH-BEST-FIT-DINS  returns  the  minimum  CN  dimensions  necessary 
;  to  satisfy  the  request  for  IQ-PROGESSQRS . 

(defun  cm-best-f it“dima  (no^processors) 

(second  (assoc  no'processors 

ecm-dimensionse 
.test  •»<*))) 


Processor  Allocator 


(^proclaim  *(type  boolean-pvar  freep!!)) 

(•defvar  freep!!  t!!)  ;  is  processor  free? 

(defvar  distance-f rom-grid-center ! ! )  ;  processor  distance  from  grid  center, 

;  allocated  during  *C0LD-B00T 

;  DISTAICE-FROH-GRID'CEITER  returns  a  grid-distance-pvar  containing 
;  each  processor’s  distance  from  the  grid  center. 

•- : •lisp-simulator 

(•proclaim  ’(ftype  (function  (t)  grid-distance-pvar)  distance-from-grid-center ! ! ) ) 

(•defun  distance-from-grid-center!!  () 

(•let  ((distance!!  (!!  0))) 

(declare  (type  grid-distance-pvar  distance!!)) 

(dotimes  (n  ♦number-of-dimensionsv) 

(•set  disteince ! ! 

(+  !  !  distjmce  !  ! 

(abs!!  (-!!  (self-address-grid!!  (the  grid-dimension-pvar  (!!  n))) 
(grid-center!!  n)))))) 

distance ! ! ) ) 

;  IBIT-PROCESSOR-ALLOCATIOI  initialiazes  the  processor  allocator. 

(defun  init-processor-allocat ion  () 

(setf  dist2Uice-from-grid-center !  ! 

(allocate ! !  (dist«aice-from-gr id-center  f ? ) 

’distance-from-grid-center! ! 

’grid-distance-pvar) ) 
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;  Reset  the  processor  allocator  after  eCOLD-BOOT. 

#+ : *lisp-hardeare 

(add-initialization  "Init  Processor  illocation'* 

’ ( init-processor-allocat ion) 
^♦aftor-ecold-boot-initializationse) 


#+ ; ♦lisp-simulator 

(add-initialization  :name-of-form  "Init  Processor  Allocation" 

:f orm  * (init-processor-allocation) 

: variable  ’eafter-^cold-boot-initializations*) 


Processor  Allocation  Modes 

cube  address 

random 

grid  address 

distance  from  grid  center 
weighted  distance  from  grid  center 


;  PALLOC-BY-CUBE-ADDR! !  returns  a  cube  address  ordering  of  the  free  processors. 

#- : *lisp-simulator 

(♦proclaim  ’(ftype  (function  (t)  cube-address-pvar)  palloc-by-cube-addr ! ! ) ) 

(♦defun  peilloc-by-cube-addr !  !  () 

(enumerate ! ! ) ) 

;  PALLQC-RAIDQN! !  returns  a  random  ordering  of  the  free  processors, 
t- : ♦lisp-simulator 

(♦proclaim  ’ (ftype  (function  (t)  cube-address-pvar)  palloc-random! !)) 

(♦defun  palloc-random! !  () 

(ranX! !  (random!!  (max-int!!)) 

><“!!)) 

]  PALLOC-BY-GRID-ADDR! !  returns  a  grid  address  ordering  of  the  free  processors. 

#- : ♦lisp-simulator 

(♦proclaim  ’ (ftype  (function  (t)  cube-address-pvar)  palloc-by-grid-addr ! ! ) ) 

(♦defun  palloc-by-grid-addr! !  () 

(♦let  ((addr!!  (self-address-grid!!  (dimension-no!!  (1-  vnumber-of-dimensions*))))) 
(declare  (type  cube-address-pvar  addr!!)) 

(do  ((dim-no  (-  ♦number-of-dimensions*  2)  (1-  dim-no)) 

(dim-sizes  (rest  (reverse  ♦current-cm-conf igurationv) ) 

(rest  dim-sizes))) 

((minusp  dim-no)) 

(♦set  addr!! 

(+1 !  (♦! !  addr! ! 

(the  cube-address-pvar 

(!!  (expt  2  (ceiling  (log  (first  dim-sizes)  2)))))) 
(self-address-grid!!  (dimension-no!!  dim-no))))) 

(rank ! !  addr ! ! 

*<=!•))) 

;  PALLQC-FROH-GRID-JEITER! !  returns  an  ordering  of  the  free  processors 
i  by  increasing  distance  from  the  grid  center. 

•- : vlisp-simulator 

(♦proclaim  ’(ftype  (function  (t)  cube-address-pvar)  palloc-from-grid-center! !)) 

(♦defun  palloc-from-grid-center!!  () 

(rank!!  distance-f rom-gr id-center ! !  *<=!!)) 
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;  PALLOC-FROH-GRID-CEITER-VEIGHTED ! !  raturns  a  randOB  ordaring  of  tha  fraa  procassors 
;  saightad  by  incraasing  distanca  from  tha  grid  cantar. 

I 

t- :  *lisp-sij&ulator 

(♦proclaim  * (f type  (function  (t)  cube-address^pvax)  palloc-from-grid-center-weighted! !)) 


(♦defun  palloc-from-grid-center-eeighted! !  () 

(ranX! !  (♦! !  distance-f rom-grid-center ! ! 

(random!  ! 

(!!  (truncate  ♦cm-maz-int^ 

♦max-hopa-to-center^)))) 


^<=!  !)) 


;  Legal  allocation  modes  and  associated  ordering  functions 

(dt fvar  ♦palloc-legal-allocat ion-modese 

’ ( ( : cube-addr  .  palloc-by-cube~addr ! ! ) 

(:reuidom  .  palloc-random! ! ) 

( . grid-addr  .  palloc-by-grid-addr ! ! ) 

( : grid-center  .  palloc-f rom-grid-center ! ! ) 

( :grid-center-weighted  .  palloc-f rom-grid-center-eeighted! !))) 


Processor  Allocator 


;  OUT-OF-PRQC-P  signals  an  error  if  there  are  fever  than  I  free  processors. 

(defun  out-of-proc-p  (n) 

(if  (<  (♦when  freep!!  (count-css))  n) 

(error  "PALLOC!!  can^t  allocate  'a  processor"  :♦* [s" ; 8-]>"  n))) 

;  GET-ALLOCATIOl-FUICrriQI  returns  the  ordering  function  for  ALLOCATIOI-HODE. 
;  If  ALLQCATIOB-MODE  is  illegal,  GET-ALLOCATIOi-FUICTIOI  asserts  an  error. 

(defun  get-allocation-function  (allocation-mode) 

(assert  (assoc  allocation-mode  ♦palloc-legal-allocation-modese) 
(allocation-mode) 

"Unknown  allocation  mode  "s"  allocation-mode) 

(rest  (assoc  allocation-mode  ♦palloc-legal-allocation-modes*))) 

;  FOR-FIRST-I-PROC  executes  BODY  with  the  currently  selected  set 
;  composed  of  the  first  I  processors  by  cube  address. 

(defmacro  f or-f irst-n-proc  ((n)  tbody  body) 

‘(♦when  (<!!  (self-address!!)  (the  cube-address-pvar  (!!  ,n))) 

,0body) ) 

;  In  Allegro  CL,  set  FRED  indentation  for  macro 

#+:ccl 

(pushnew  ’ (f or-f irst-n-proc  .  1) 

ccl : : *fred-8pecial-indent-aliste 
:test  equal) 

;  PALLOC! !  returns  a  cube-address-pvar  containing  the  cube  addresses  of  I 
;  free  processors  allocated  according  to  ALLOCATIOI-NODE. 

#- : ♦lisp-simulator 

(♦proclaim  ^(ftype  (function  (t)  cube-address-pvar)  palloc!!)) 

(•defun  palloc!!  (n  ftoptional  (allocation-mode  :cube-addr)) 

(let  ((allocation-function 

(get-allocat ion- function  allocat ion-mode) )) 

(•all 

(unless  (out-of-proc-p  n) 

(♦let  (rendezvous! !) 

(declare  (type  cube-addre8s-pv2a:  rendezvous!!)) 

(•if  freep ! ! 
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(*p8et  ino-collisions 

(self-address ! ! ) 
rendezvous ! ! 

(efuncall  allocation-function))) 

(for-f irst-n-proc  (n) 

(*pset  ; no-collisions 
nil!  ! 
freep! ! 
rendezvous ! ! ) 

(sort!!  rendezvous!!  ’<=!!))))))) 

;  PALLOC  returns  an  array  containing  the  cube  addresses  of  1  free  processors 
;  allocated  according  to  ALLQCATIQI-MODE . 

(defiio  palloc  (n  Aoptional  (allocation-mode  .oubo-addr)) 

(pvar-to-array  (palloc!!  n  allocation-mode) 

(make-array  n) 

: cube-address-end  n)) 

;  PALLOC-OHE  returns  the  cube  address  of  the  next  free  processor 
;  allocated  according  to  AIXOCATIOI-MODE . 

(defmacro  palloc-one  (Aoptional  (allocation-mode  :cube-addr)) 

‘ (aref  (palloc  1  .allocation-mode)  0)) 

;  UITH-I-PRQC-ALLOCATED  allocates  I  free  processors  according  to  ALLOCATIOI-MODE  and 
;  sets  ADDR  to  an  array  containing  the  cube  addresses  of  the  allocated  processors. 

;  WITH-I-PROC-ALLOCATED  then  executes  BODY  with  the  currently  selected  set 
;  composed  of  the  nesly  allocated  processors. 

I 

(defmacro  eith-n-proc-allocated  ((n  addr 

Aoptional  (allocation-mode  :cube-addr)) 

Abody  body) 

(let  ((p-addr!!  (gensym)) 

(new-proc-p! !  (gensym))) 

‘(let  (,addr) 

(♦all 

(•let  ((, p-addr!!  (palloc!!  ,n  .allocation-mode)) 

( .new-proc-p! !  nil!!)) 

(declare  (type  cube-address-pvar  .p-addr!!) 

(type  boole^ul-pvar  .neu-proc-p! !)) 

(setf  .addr  (pvar-to-array  .p-addr!! 

(make-array  .n) 

; cube-address-end  .n)) 

(♦if  (<!!  (self-address ! ! )  (the  cube-address-pvar  (!!  ,n))) 

(♦pset  : no-collisions 
t!  ! 

.nev-proc-p ! ! 

.p-addr! !)) 

(♦shen  .nev-proc-p ! ! 

.Cbody)))))) 

;  In  Allegro  CL.  set  FRED  indentation  for  macro 
f+ : ccl 

(pushneu  ’  (uith-n-proc-2Lllocated  .  1) 

ccl : ; ♦fred-special-indent-alistv 
:test  t’equal) 


; ; ;  EOF 
#+;ccl 

(format  t  ""X\"Processor  Allocation\"  loaded") 
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;;;  Node:  LISP;  Syntax:  Conimon*lisp;  Package:  ♦LISP;  Base:  10  -♦- 
(in-package  ’♦lisp) 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 

; ; ;  Tomboulian  Implementation 
;;;  leighbor  Addressing 


;  Veighbor  Addressing  parameters 
(defvar  *self-loops-pe  t) 

(defvar  ♦neighbor-limite) 

(defvar  ♦neighbor-no-size^) 


;  alloe  self-neighbors? 

;  max  niu&ber  of  neighbors 
;  max  neighbors  field  size 


;  Define  neighbor  addressing  pvar  type 
;  BEIGHBOR-IQ-PVAR  [0 .max  neighbors) 

(eval-when  (compile  load  eval) 

(deftype  neighbor-no-pvar  ()  ’(pvar  (unsigned- byte  ♦neighbor-no-size*))) 
(deftype  neighbor-no  ()  ’(unsigned-byte  ♦neighbor-no-sizee)) 

\ 

;  When  using  simulator,  add  nee  pvar  type  symbols 
i+ : ♦lisp-simulator 

(pushnee  ’neighbor-no-pvar  ••lisp-exported-type-symbols^) 


;  lEIGHBOR-LIMIT! !  returns  a  neighbor-no-pvar  containing  neighbor  limit. 

(defmacro  neighbor-limit!!  () 

‘(the  neighbor-no-pvar  (!!  ♦neighbor-limit*))) 

;  lO-IEIGHBORS  returns  the  neighbor  limit  for  a  grid  eith  lO-DIHElSIOBS . 

;  If  SELF-LOOPS-P  is  T,  then  self-neighbors  are  alloeed. 

(defun  no-neighbors  (no-dimensions  self-loops-p) 

(■♦•  (♦  2  no-dimensions) 

(if  self-loops-p  1  0))) 

;  SELF-IEIGHBOR-P  returns  T  if  lEIGHBOR-IO  represents  the  self-neighbor. 

(defun  self-neighbor-p  (neighbor-no) 

(and  ♦self-loops-p* 

(=  neighbor-no  (1-  *neighbor-limit*) )) ) 

;  If I"-IEIGHBOR-ADDRESSIIG  initialiazes  the  neighbor  addressing  parameters. 

(defun  init-neighbor-addressing  () 

(setf  ♦neighbor-limit* 

(no-neighbors  *nuffiber-of -dimens ions*  vself-loops-p*) 
♦neighbor-no-size*  (ceiling  (log  *neighbor-limit*  2)))) 
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;  Reset  neighbor  addressing  parameters  after  *C0LD~B00T. 
#+ ; elisp-hardBare 

(add-initialization  'Tnit  laighbor  iddresaing" 

’ (init-neighbor- addressing) 
’*after-*cold-boot-initializations*) 


t+ : elisp-simulator 

(add-initialization  :name-of-form  'Tnit  leighbor  Iddrassing" 

;form  ’ (init-neighbor-addressing) 

: variable  **after-*cold-boot-initializations*) 

;  *C0LD-B00T  CM  to  current  grid  dimensions. 

(♦cold-boot) 


;  leighbor  Addressing  Utilities 


;  lEIGHBOR-IO-IIVERSE  returns  the  inverse  link  for  lEIGHBOR-IO . 

(defun  neighbor-no-inverse  (neighbor-no) 

(if  (Md  vself-loops-p*  (=  neighbor-no  (1-  vneighbor-limitv) ) ) 
neighbor-no 

(if  (evenp  neighbor-no) 

(1+  neighbor-no) 

(1-  neighbor-no)))) 

;  Parallel  lEIGHBOR-IQ-IlVERSE 

#+ : ♦lisp-hardvare 

(•proclaim  ’(ftype  (function  (t)  neighbor-no-pvar)  neighbor-no-inverse ! ! ) ) 

(•defun  neighbor-no-inverse!!  (neighbor-no!!) 

(declare  (type  neighbor-no-pvar  neighbor-no!!)) 

(•let  (inverse!!) 

(declare  (type  neighbor-no-pvar  inverse!!)) 

(•set  inverse!! 

(if!!  (=!!  neighbor-no!!  (1-!!  (neighbor-limit!!))) 
neighbor-no! ! 

(if!!  (evenp!!  neighbor-no!!) 

(1+!!  neighbor-no!!) 

(1-!!  neighbor-no!!)))) 

inverse !  ! )  ) 


;  GRID-OFFSET-FROH-IEIGHBOR-IO  returns  the  grid-offset  for  lEIGHBOR-IO  along  DIMEHSIOH. 

(defun  grid-offset-from-neighbor-no  (neighbor-no  dimension) 

(if  (/=  (truncate  neighbor-no  2)  dimension) 

0 

(if  (evenp  neighbor-no)  -1  +1))) 

;  GRID-OFFSETS-FROH-IEIGHBOR-IO  returns  the  grid-offsets  for  lEIGHBOR-IO. 

(defun  grid-offsets-from-neighbor-no  (neighbor-no) 

(mapcar  (’(lambda  (dim) 

(grid-offset-from-neighbor-no  neighbor-no  dim)) 

(enumerate  •number-of-dimensionsv)) ) 

;  Parallel  GRID-OFFSET-FROM-IEIGHBOR-IO 

#+ : •lisp-hardvare 

(•proclaim  ’(ftype  (function  (t)  grid-offset-pvar)  grid-offset-from-neighbor-no!!)) 

(•defun  grid-offset-from-neighbor-no!!  (neighbor-no!!  dimension!!) 

(declare  (type  neighbor-no-pvar  neighbor-no!!) 
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(type  grid-dimension-pTar  diaenslon! ! )) 

(cond! !  <(/=*!  (truncate!!  neighbor-no!!  (!!  2))  dimension!!}  dimension!!) 
((eeenp!!  neighbor-no!!)  (!!  -1)) 

(t! !  (! !  +1)))) 


;  CUBE-FROH-IEIGHBOR-IO  returns  the  cube  address  of  the  processor  connected 
;  by  the  lEIGHBOR-IO  link  to  the  processor  at  CUBE-IODR. 

(defmacro  cube-from-neighbor-no  (cube-addr  neighbor-no) 

‘ (cube-from-grid-address 
,C(mapcar  *’ (lambda  (d) 

‘ (+  (grid-from-cube-address  , cube-addr  ,d) 

(grid-off set-from-neighbor-no  , neighbor-no  ,d))) 
(enumerate  *number-of-difflens ions*} ) ) ) 


OFF-GRID-iEIGHBOR-P! !  returns  a  boolean-pvar  indicating  if  each  processor 
has  a  HEIGHBOR-IO  link. 


(defmacro  off-grid-neighbor-p ! !  (neighbor-no) 

(let  ((off-p!!  (gensym))) 

‘(the  boolean-pesur 

(•let  ((, off-p!!  nil!!)) 

(declare  (type  boolean-pvar  , off-p!!)) 

(cond 

,<(mapcar  t’ (lambda  (n) 

‘((=  , neighbor-no  ,n) 

(•set  , off-p!! 

(off-grid-border-relative-p! ! 

.•(mapcar  (’(lambda  (offset) 

‘(!!  .offset)) 

(grid-off sets-from-neighbor-no  n) ) ) ) ) ) 
(enumerate  •neighbor-limit*))) 

, off-p! ! )) 


)) 


;  leighbor  Addressing  Read  Operations 

;  PREF-l-IEIGHBOR! !  roads  SOURCE-PVAR  into  DEST-PVAR  from  the  direction  MEIGHBOR-HD. 

(defmacro  pref-l-neighbor !  !  (dest-pvar  80urco-pv^lr  neighbor-no) 

‘(case  , neighbor-no 
.@(mapcar 

(’(lambda  (n) 

‘(,n 

(•set  ,dest-p»ar 

.(if  (self-neighbor-p  n) 
source-pvar 
‘ (nees ! ! 

.source-pvar 
.((mapcar  (’(lambda  (d) 

(grid-offset-from-neighbor-no  n  d)) 
(enumerate  •numbor-of-dimensions*) ) 

))) 

)) 

(enumerate  •neighbor-limit*))) 


;  PRF.F-SEIGHBOR!  !  reads  SOURCE-PVAR  into  DEST-PVAR  from  the  directions  in  BEIGHBOR-NO-PVAR . 

(defmacro  pref-neighbor ! !  (dest-pvar  source-pvar  neighbor-no-pvar) 

(let*  ((temp-neighbor  (if  (listp  neighbor-no-pvar) 

(gensym) 

neighbor-no-pvar) ) 

•cond-exp) 

(setf  ‘cond-exp 


76 


NRL  REPORT  9167 


(if 


‘ (•cond 

,C(raapcar 

t ’ (lambda  (n) 

'((=!!  .temp-naighbor  (•!  ,n)) 

(♦set 

.dest-pvar 

.  (if 

(self-neighbor-p  n) 

source-pvar 

‘ (news ! !  ,8ource-p»ar 

,<(mapcar  •’ (lambda  (d) 

(grid-off sat-from-noighbor-no  n  d)) 
(enomerate  ♦number-of-dimansionsa) ) ) 


)))) 

(enumerate  aneighbor-limit*)))) 

(listp  neighbor-no-pvar) 

(append 

‘(♦let  ((, temp-neighbor  ,neighbor-no-p*ar)) 

(decleu-e  (type  neighbor-no-pvar  .temp-neighbor))) 
(list  acond-erp)) 

♦cond-eip))) 


;  leighbor  Addressing  Write  Operations 

;  aPSET-l-HEIGHBQR  writes  SOURCE-PVAR  into  DEST-PVAR  according  to  the  direction  HEIGHBOR-NO. 

(defmacro  apset-l-neighbor  (source-pvar  dest-pvar  neighbor-no) 

‘(case  , neighbor-no 
,fl(raapcax 

t> (lambda  (n) 

‘(,n 

.(if  (self-neighbor-p  n) 

‘(♦set  .dest-pvar  .source-pvar) 

‘(♦pset  ;no-collisions 
.source-pvar 
.dest-pvar 

(cube-from-grid-addresB ! ! 

,4(mapcar 

t’ (lambda  (d) 

‘(+!!  (self-address-griu! !  (!!  .d)) 

(!!  . (grid-off set-from-neighbor-no  n  d)))) 
(enumerate  anumber-of-dimensionsa) ) ) ) 

))) 

(enumerate  aneighbor-limita) ) 

)) 


;  aPSET-IEIGHBOR  writes  SOURCE-PVAR  into  DEST-PVAR  using  COHBIIER  according 
:  to  the  directions  in  lEIGHBOR-IO-PVAR . 

(defmacro  apset -neighbor  (combiner  source-pvar  dest-pvar  neighbor-no-pvar) 

(leta  ((temp-neighbor  (if  (listp  neighbor-no-pvar) 

(gensym) 

neighbor-no-pvar) ) 

♦pset-exp) 

(setf  apset-exp 
‘ (apset 

.combiner 
, source-pvar 
.dest-pvar 

(cube-f rom-grid-address !  ! 

,C(mapcar 

t’ (lambda  (d) 

‘(+!!  (self-address-grid! !  (!!  .d)) 

(grid-offset-from-neighbor-no! !  .temp-neighbor  (!!  ,d)))) 
(enumerate  anumber-of-dimensionsa) ) ) 

)) 

(if  (listp  neighbor-no-pvar) 


77 


E.  M.  DEPRIT 


(append 

‘(♦let  ((.temp-neighbor  ,neighbor-no-p»ar)) 

(declare  (the  neighbor-no-pvar  .temp-neighbor))) 
(list  epset-exp)) 

♦pset-ezp) 

)) 


; ; ;  EOF 
t+:ccl 

(format  t  "■)l\"Ieighbor  lddressing\"  loaded") 


-♦-  Hode :  LISP;  Syntax:  Common-lisp;  Package:  eLISP;  Base:  10  -♦- 
(in-package  ’elisp) 

; ; ;  Etienne  Deprit 

;;;  laval  Research  Lab.  Code  8242 


Tomboulian  Implementation 
Graph  Structures 


;  Graph  Structure  parameters 
(defvac  *  time-quantum*) 

(defvar  »free«) 

(defvar  *max-path-length«) 

(defeat  »path-len-size*) 

:  Define  graph  structures  pear  type 
;  PATH-LEIGTH-PVAR  [O.max  path  length) 

(eval-Hhen  (compile  load  eval) 

(deftype  path-length-pear  ()  ’(pear  (unsigned-byte  *path-len-size*))) 

) 

;  Ifhen  using  simulator,  add  new  pear  type  symbols 
*+ : ‘lisp-simulator 

(pushnew  ’path-length-pear  •♦lisp-eiported-type-symbols») 

(defear  has-neighbor-p[]  .' ! )  ;  array  of  pears  indicating  neighbor  links 

(defear  slots[]!!)  ;  array  of  slot  structures 

(defear  trial-slots[] ! ! )  ;  array  of  trial-slot  structures 

(♦proclaim  ’(type  boolean-pear  actieep!!)) 

(•proclaim  ’(type  boolean-pear  next-act ieep !!) ) 

(•proclaim  ’(type  boolean-pear  dest Inat ionp ! ! ) ) 


;  time  quantum  for  routing 
;  free  slot  flag 
;  max  path  length  in  graph 
;  max  path  length  field  size 
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(^proclaim  ’(type  boolean-pvar  reachedp!!)) 

(♦defvar  activepM)  ;  boolean-p^ar  indicating  active  processors 


;  NAKE-HAS-IEIGHBOR*’P  returns  an  array  of  pvars  indicating  the  existence 
;  of  neighbor  links  in  each  neighbor  direction. 

(defun  make'has*neighbor-p  () 

(let  ( (has*neighbor~p  (make-array  eneighbor-limit*))) 

(♦all 

(dotimes  (n  ♦neighbor-limit*) 

(setf  (aref  has-neighbor-p  n) 

(allocate!!  nil!! 

(format  nil  *'has-neighbor-^a-p*’  n) 

’boolean-pvar) ) 

(♦set  (the  boolean-pvar  (aref  has-neighbor-p  n)) 

(not!!  (off-grid-neighbor-p! !  n))) 

)) 

has-neighbor-p)) 

;  HAS-IEIGKBOR-I-P! !  returns  the  boolean-pvar  indicating  the  existence  of  link  lEIGHBOR-BO . 

(defmacro  has-neighbor-n-p ! !  (neighbor-no) 

* (the  boolean-pvar  (aref  has-neighbor-pC] ! !  ,neighbor-no))) 


Routing  Slots 


;  Arc  label  stubs 

(defstruct  arc-label 

) 

(defun  ecopy-arc-label  (label!!  addr  label) 
(declare  (ignore  label!!  addr)) 
label) 


;  Routing  slot 


(defstruct  (slot 

(iconc-name  slot-i-) 

( iconstructor  make-slot-internal)) 

startp ! ! 
forward! ! 
backward! ! 
endp  I ! 
arc-label !  ! 

) 


;  beginning  of  arc? 

;  forward  link»  neighbor-no  for  read 
;  backward  link,  neighbor-no  for  read 
;  end  of  arc? 

;  label  if  beginning  of  arc 


;  Accessors  for  slot  structure 

(defmacro  slot-startp ! !  (slot) 

* (the  boolean-pvar  (slot-i-startp! !  ,slot))) 

(defmacro  slot-forward! !  (slot) 

'(the  neighbor-no-pvar  (slot-i-forward ! !  ,8lot))) 

(defmacro  slot-backward! !  (slot) 

'(the  neighbor-no-pvar  (slot-i-backward! !  ,slot))) 

(defmacro  slot-endp! !  (slot) 

'(the  boolean-pveu:  (slot-i-endp! !  .slot))) 

(defatacro  slot-2urc-label !  !  (slot) 
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* (slot-i-arc-label! !  ,8lot) ) 


;  RESET**SLOT  raaats  the  SLOT  structure. 

(defmacro  reset-slot  (slot) 

Hprogn  (eset  (slot-startp! !  ,slot)  nil!! 

(slot-foruard! !  ,slot)  (neighbor-lisdt ! !) 
(slot-backvard! !  ,slot)  (neighbor-linit ! !) 
(slot-endp!!  ,slot)  nil!!) 

.slot)) 


;  MARE-SLOT  returns  a  new  slot  structure  for  TIME  step. 

(defun  make-slot  (time) 

C . et  ((slot 

(make-slot-internal 
: startp! ! 

(allocate!!  nil  (format  nil  "startp-^a"  time)  »boolean-pvar) 
.'forward! ! 

(allocate!!  nil  (format  nil  "foruard-^a"  time)  »neighbor-no-pv2ir) 
:back92u:d!  ! 

(allocate!!  nil  (format  nil  "backward-'a"  time)  ’neighbor-no-pvar) 
: endp ! ! 

(allocate!!  nil  (format  nil  “endp-’a”  time)  ^boolean-pvar) 

: arc-label ! ! 

(funcall  *make-arc-label) 

))) 

(reset-slot  slot))) 


;  RESET-SLOTS  resets  the  array  of  SLOTS . 

(defun  reset-slots  (slots) 

(♦all 

(dotimes  (time  (length  slots)) 

(reset-slot  (aref  slots  time)))) 
slots) 

:  HAKE-SLOTS  returns  an  array  of  slots  of  size  TIME-QUAITUM. 

(defun  make-slots  (time-quantum) 

(let  ((slots  (make-array  time-quantum  :adju8table  t))) 
(dotimes  (time  time-quantum) 

(setf  (aref  slots  time)  (make-slot  time))) 
slots)) 


Trial-Slots  for  path  construction 


;  Trial-slot  structure 

(defstruct  (trial-slot 

( : conc-name  trial-slot-i-) 

( : constructor  make-trial-slot-internal)) 

direction!!  ;  neighbor-no  direction  of  trial-path 

length! !  ;  length  of  trial-path 

) 

;  Accessors  for  trial-slot  structure 

(defmacro  trial-slot-direction! !  (trial-slot) 

‘(the  neighbor-no-pvar  (tr ial-slot-i-direction ! !  .trial-slot))) 

(defmacro  trial-slot-length!!  (trial-slot) 

‘(the  path-length-pvar  (trial-slot-i-length! !  .trial-slot))) 

;  RESET-TRIAL-SLOT  resets  the  TRIAL-SLOT  structure. 
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(defmacro  reset-trial-slot  (trial-slot) 

‘ (progn  (*set  (trial-slot-direction! 1  , trial-slot)  (neighbor-limit!!) 

(trial-slot-length! !  .trial-slot)  (the  path-length-pvar  (!!  0))) 
.trial-slot)) 

;  MAKE -TRIAL-SLOT  returns  a  neo  trial-slot  structure  for  TIME  step. 

(defun  make-trial -slot  (time) 

(let  ((trial-slot 

(make-trial-slot-internal 
;direction ! ! 

(allocate!  !  nil  (format  nil  "direction-'a”  time)  'noighbor-no-pv2u:) 

; length! ! 

(allocate!!  nil  (format  nil  "length-'a"  time)  ’path-length-pvar)))) 
(reset-trial-slot  trial-slot))) 

;  *DEALLOCATE-TRIAL-SLOT  deallocates  the  pears  in  the  TRIAL-SLOT  structure. 

(defmacro  *deallocate-trial-slot  (trial-slot) 

' (pro^  .  (edeallocate  (trial-slot-direction!!  .trial-slot)) 

(*deallocate  (trial-slot-length!!  .trial-slot)))) 

;  RESET-TRIAL-SLOTS  resets  the  array  of  TRIAL-SLOT  structures. 

(defun  reset-trial-slots  (trial-slots) 

(♦all 

(dotimes  (time  (length  trial-slots)) 

(reset-trial-slot  (aref  trial-slots  time)))) 
trial-slots) 

1  HAKE-TRIAL-SLOTS  returns  an  array  of  trial-slots  of  size  TIME-QUAITUM. 

(defun  make-trial-slots  (time-quantum) 

(let  ((trial-slots  (make-array  time-quantum  :adju8tabla  t))) 

(dotimes  (time  time-quantum) 

(setf  (aref  trial-slots  time)  (make-trial-slot  time))) 
trial-slots)) 


;  IIC-TIHE-QUAITUK  gross  the  SLOTS  and  TRIAL-SLOTS  arrays  by  DELTA  time  steps. 

(defun  inc-time-quantum  (toptional  (delta  1)) 

(adjust-array  slots[]!!  (+  etime-quantom*  delta)) 

(adjust-array  trial-slotsQ  ! !  (+  ♦time-qaantume  delta)) 

(dotimes  (i  delta) 

(setf  (aref  8lots[]!!  (+  etime-quantum*  i)) 

(reset-slot  (make-slot  (+  etime-quantum*  i))) 

(a^ef  trial-slotsC] ! !  (+  ♦time-quantum*  i)) 

(reset-trial-slot  (make-trial-slot  (+  ♦time-quantum*  i))))) 

(incf  ♦time-quant\im*  delta)) 

;  IIIT-GRAPH-STRUCTURES  initialiazes  the  graph  structures. 

(defun  init-graph-structures  () 

(setf  etime-quantum*  1 

♦free*  ♦neighbor-limit* 

♦max-path-length*  (♦  2  ♦max-hops*) 

♦path-len-size*  (ceiling  (log  ♦max-path-length*  2)) 
has-neighbor-pC  !  !  (make-has-neighbor-p) 
slots[]!!  (make-slots  ♦time-quantum*) 
trial-slots[] ! !  (make-trial-slots  *tlme-quantum*))) 

;  Reset  graph  structures  after  *0010-8001. 

#+ : *lisp-hardware 

(add-initialization  "Init  Graph  Routing  Strucs" 

’ ( init-graph-structures) 
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’♦after-*col<i-boot- initializations*) 


t+ : •lisp-simulator 

(add-initialization  rname-of-form  "Init  Graph  Routing  Strucs" 
rforiD  *  (init-graph-structures) 
r^ariaole  ’*after-*cold-boot-initializations*) 


; ; ;  EOF 
#+:ccl 

(format  t  ""'/A''Graph  StructuresV"  loaded”) 


;;;  -•-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  ♦LISP;  Base:  10  -•- 
(in-package  ’♦lisp) 


Etienne  Deprit 

Naval  Research  Lab,  Code  8242 


Tomboulian  Implementation 
Graph  Hooks 


;  Arc  label  slot  specification 

(defstruct  (slot-spec  (:type  list)) 
label 

initial-value 
name 
type) 

;  Arc  label  slot  accessors 

(defun  slot-label  (slot) 

(if  (listp  slot) 

(slot -spec-label  slot) 
slot) ) 

(defun  slot-initial-value  (slot) 

(if  (listp  slot) 

(slot-spec-initial-value  slot))) 

(defun  slot-name  (slot) 

(if  (listp  slot) 

(slot-spec-name  slot))) 

(defun  slot-type  (slot) 

(if  (listp  slot) 

(slot-spec-type  slot))) 

;  STRINGS-TO-SYMBOL  returns  the  symbol  formed  by  the  concatenation  of  STRINGS. 

(defmacro  strings-to-symbol  (trest  strings) 

' (read-from-str ing  (funcall  •’ concatenate  ’string  ,€strings))) 

i  MAKE-ARC-SLOTS  returns  slots  for  the  CM  arc  label  structure. 

(defun  make-arc-slots  (slots) 

(mapcar 


slots  fed  to  ALLOCATE!! 
slot  label 
initial  value 
slot  name 
pvar  type 
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i’Cleunbda  (slot) 

^  ,  (strings-to-symbol  (string  (slot-lab«l  slot*) 

(allocate!!  ,(if  (slot-initial-value  slot) 

'(!!  .(slot-initial-value  slot))) 

.(slot-name  slot) 

,C(if  (slot-type  slot) 

*(’, (slot-type  slot)))))) 

slots)) 

;  MAKE-CM-ARC  writes  the  defstruct  form  to  create  the  CM  eirc  label  structure 
;  called  LABEL-IAME  and  containing  the  given  SLOTS. 

(defun  maXe-cm-arc  (label-name  slots) 

‘(defstruct  (airc-label 

( : conc-name 

,  (strings-to-symbol  (string  label-name)  *'-i-"))) 

,Q(maXe-arc-slots  slots) 

) 

) 

;  MAKE-ARC-ACCESSORS  writes  the  accessor  macros  for  the  CM  arc  label  structure. 

(defun  make-arc-accessors  (label-name  slots) 

(mapcar 

(lambda  (slot) 

(let*  ((slot-label  (string  (slot-label  slot))) 

(slot-accessor 

‘(list  (strings-to-symbol  (string  label-name)  slot-label  "!!") 

arc) ) ) 

‘ (defmacro 

,  (strings-to-symbol  (string  label-name)  slot-label  '*!!”) 

(arc) 

,(if  (slot-type  slot) 

‘(list  ’the  ’.(slot-type  slot)  .slot-accessor) 
slot -accessor) )) ) 

slots) 

) 

;  MAKE-FE-ARC  writes  the  defstruct  form  to  create  the  FE  arc  label  structure 
;  called  LABEL-IAME  and  containing  the  given  SLOTS. 

(defxin  make-fe-arc  (label-name  slots) 

‘(defstruct  .label-name 

,®(mapcar  f’slot-label  slots))) 

,  MAKE-ARC-COPIER  writes  the  arc  label  copy  function  to  copy  an  FE  arc  label 
;  into  the  CM  arc  label  at  the  processor  with  the  given  cube  ADDR. 

(defun  make-arc-copier  (label-name  slots) 

' (defun  *copy-arc-label  (label!!  addr  label) 

(setf 

,9(mapcan 

t’ (lambda  (slot) 

‘ ( (pref  ( , (strings-to-symbol 

(string  label-name)  (string  (slot-label  slot))  "!!*’) 

label ! ! )  addr) 

( , (strings-to-symbol 

(string  label -name)  (string  (slot-label  slot))) 

label)) 

) 

slots) ) 

label) 

) 

,  DEF-ARC-LABEL  defines  corresponding  FE  and  CM  arc  label  structures 
called  LABEL-IAME  and  containing  the  given  SLOTS. 

(defmacro  def-arc-label  (label-name  tbody  slots) 

‘ (progn 
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, (■aka-cm'arc  labal-naae  slots) 
jCCnaka^arc-accessors  label**xiaBe  slots) 
, (make-fe-arc  label-nama  slots) 

, (maka-arc'copiar  labal*nama  slots) 

)) 


Arc  Label  Access 


;  FOR'-ALL-ARC-STARTS  loops  through  all  slot  structures  and  executes  BODY 
;  with  the  currently  selected  set  composed  of  all  processors  containing 
;  the  beginning  of  a  graph  arc.  LABEL-lAKE  is  bound  to  the  current  CM 
,  <irc  label  structure. 

(defmacro  f or-all-arc-starts  ((label-name)  Abody  body; 

(let  ((time  (gensym))) 

^(let  (slot 

^label-neune) 

(dotimes  (,time  etlme-quantum*) 

(setf  slot  (aref  slotsC]!!  ,time) 

, label-name  (slot-arc-label! f  slot)) 

(♦when  (slot-startp ! (  slot) 

,«body))))) 

:  FOR-ALL-ARC-EIDS  loops  through  all  slot  structures  and  executes  BODY  with 
;  the  currently  selected  set  composed  of  all  processors  containing  the  end 
;  of  a  graph  arc.  LABEL-IAKE  is  bound  to  the  current  CK  arc  label  structure. 

(defmacro  f or-all-arc-ends  ((label-name)  Abody  body) 

(let  ((time  (gensym))) 

'(let  (slot 

, label-name) 

(dotimes  (,time  ♦time-quantum*) 

(setf  slot  (aref  slots[]!!  .time) 

.label-name  (slot-arc-label! !  slot)) 

(♦when  (slot-endp!!  slot) 

.fibody))))) 

;  In  Allegro  CL,  set  FRED  indentation  for  macros 

#+;ccl 

(progn 

(pushnew  ^ (f or-all-arc-starts  .  1) 

ccl: :*fred-special-indent-alist* 
rtest  f^equal) 

(pushnew  ’ (f or-all-arc-ends  .  1) 

ccl: : ♦fred-special-indent-alist* 

:test  f^equal)) 

; ; :  EOF 
#+ : ccl 

(format  t  "'*/,\"Oraph  Hooks\"  load-  '") 


;;;  -♦-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  ♦LISP;  Base:  10  -♦- 
(in-package  ^♦lisp) 


Etienne  Deprit 

■aval  Research  Lab.  Code  8242 
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Tomboiilian  Impleiisntation 
Graph  Construction 


;  FREE-TO-SEIDP ! !  returns  a  boolean-pvar  indicating  if  each  processor 
;  is  free  to  send  in  the  current  time  step. 

(defmacro  f ree-to-sendp ! !  O 

'(=!!  (slot-backsard! !  current-slot) 

(neighbor-limit ! ! ))) 

;  WHEB-HAS-IEIGHBOR-P  executes  BODY  with  the  currently  seleced  set 
;  composed  of  processors  sith  lEIGHBOR-IO  links. 

(defmacro  ehen-has-neighbor-p  ((neighbor-no)  tbody  body) 

‘(♦when  (has-neighbor-n-p! !  , neighbor-no) 

,Obody) ) 

;  In  Allegro  CL,  set  FRED  indentation  for  macro 
#+ : ccl 

(pushnee  ’ (nhen-has-neighbor-p  .  1) 

ccl : :»fred-special-indent-alist* 

:test  t’equal) 

;  WHEI-IEIGBHOR-FREE  executes  BODY  vith  the  currently  selected  set  composed 
;  of  processors  sith  neighbors  free  to  receive  along  lEIGBBOR-IO  link. 

(defmacro  shen-neighbor-free  ((neighbor-no)  Abody  body) 

‘ (progn 

(pref-l-neighbor ! !  neighbor-alot-forward! ! 

(slot-foroard! !  current-slot) 

, neighbor-no) 

(♦when  («! '.  neighbor-slot-forward!!  (neighbor-limit!!)) 

,Cbody))) 

;  In  Allegro  CL,  set  FRED  indentation  for  macro 
*+;ccl 

(pushnew  ’ (when-neighbor-free  .  1) 

ccl ; : ♦fred-special-indent-alist ♦ 

:test  t’equal) 

;  WHEl-SHORTER-PATH-TO-IEIGBHOR  executes  BODY  with  the  currently  selected  set 
;  composed  of  processors  with  shorter  trial-paths  along  lEIGHBOR-lO  link. 

(defmacro  when-shnrter-path-to-neighbor  ((neighbor-no)  tbody  body) 

‘ (progn 

(pref-l-neighbor!!  ne ighbor-slot -length ! !  trial-slot-length!!  , neighbor-no 
(♦when  (or ! ! 

(=!!  neighbor-slot-length!!  (!!  0)) 

(<!!  (trial-slot-length!!  last-trial-slot) 
neighbor-slot-length! !)) 

, tbody) ) ) 

;  In  Allegro  CL,  set  FRED  indentation  for  macro 
#+ : ccl 

(pushnew  ’ (when-shorter-path-to-neighbor  .  1) 
ccl : : ♦fred-special-indent-aliste 
:test  t’equal) 

;  UPDATE-TRIAL-PATH-TO-IEIGHBOR  updates  a  trial-path  for  each  processor 
;  in  the  currently  selected  set  along  lEIGHBOR-IO  link. 

(defmacro  update-trial-path-to-neighbor  (nej^hbor-no) 

‘ (progn 
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(*pset-l-iieighbor  (!!  (the  neighbor-no  (neighbor-no-inverse  ,neighbor-no))) 
(trial-slot-direction! !  cnrrent-trial-slot) 

, neighbor-no) 

(•pset-l-neighbor  (the  path-length-prar  (1+!!  (trial-slot-length! !  last-trial-slot))) 
(trial-slot-length! !  current-trial-slot) 

,neighbor-no))) 

;  FLQOD-TRIAL-PATHS  floods  all  possible  shortest  trial-paths  from  the  processor 
;  with  cube  address  FROM-ADDR  to  the  processor  at  TQ-ADDR.  FLOOD-TRIAL-PATHS 
;  returns  T  if  some  trial-path  reached  TO-ADDR,  IIL  otherwise.  IIC-TIME-QUAHTUK-P 
;  allows  the  time  quantum  to  be  incremented  if  the  destination  is  not  reached. 

(defun  flood-trial -paths  (from-addr  to-addr  Akey  inc-time-quantum-p) 

(*all 

(reset-trial-slots  trial-slots [] ! !) 

(♦set  activep!!  nil!!) 

(setf  (pref  activep!!  from-addr)  t) 

(let  ((reached-p  nil) 

(base-time  0) 
current-slot 
current -trial-slot 

(last-trial-slot  (make-trial-slot  -1))) 

(•let  (neighbor-slot-forward! ! 
trial-slot-length! ! 
neighbor-slot-length! !) 

(declare  (typo  neighbor-no-pvar  neighbor-slot-forward! ! ) 

(type  path-length-pv2ir  trial-slot-length! !  neighbor-slot-length!!)) 


(do  () 

((or  reached-p 

(and  (plusp  base-time)  (not  inc-time-quantum-p)))) 

(do  ((time  base-time  (1+  time))) 

((=  time  •time-quantume)) 

(setf  base-time  *timo-quantum* 

current-slot  (aref  8lots[]!!  time) 
curront-trial-slot  (aref  trial-slots [J ! !  time)) 

(•sot  trial-slot-length! ! 

(trial-slot-length! !  last-trial-slot)) 

(•when  (2uid!!  activep!!  (free-to-sendp! !)) 

(dotimes  (n  •neighbor-limitv) 

(when-has-neighbor-p  (n) 

(when-noighbor-f ree  (n) 

(when-shorter-path-to-neighbor  (n) 

(update-trial-path-to-neighbor  n)))))) 

(♦set  activep!!  nil!!) 

(•when  (/=!!  (trial-slot-direction!!  current-trial -slot)  (neighbor-limit!!)) 
(•set  activep!!  t!!)) 

(when  (pref  activep!!  to-addr) 

(setf  (pref  activep! !  to-addr)  nil) 

(if  (=  (pref  (slot-forward!!  current-slot)  to-addr)  eneighbor-limit*) 

(setf  reached-p  t) 

(setf  (prof  (trial-slot-length!!  current-trial-slot)  to-addr)  0))) 

(setf  (pref  activep!!  from-addr)  t) 

(•set  (trial-slot-length!!  last-trial-slot) 

(trial-slot-length! !  current-trial-slot)) 

(setf  (pref  (trial-slot-length! !  last-trial-slot)  from-addr)  0) 

) 

(if  (and  (not  reached-p)  inc-time-quantum-p  ) 

( inc-t ime-quantuffl) ) 

)) 
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(♦deallocate-trial-slot  la8t-trieJ.-8lot ) 
reached-p 
))) 

;  SHORTEST-TRIiL-PiTH-TIME  returns  the  time  step  on  arrival  and  path  length 
;  of  the  shortest  trial -path  reaching  the  destination  processor  at  cube  IDDR. 

(defun  shortest-trial-path-time  (addr) 

(let  ((path-length  (1+  »max-path-length*) ) 
path-time 
trial-slot -length) 

(dotimes  (time  *time-quantum*) 

(setf  trieOL-slot-length 

(pref  (trial-slot-length!!  (aref  trial-slots []! !  time))  addr)) 

(if  (and  (plusp  trial-slot -length) 

(<  trial-slot-length  path-length)) 

(setf  path-length  trial-slot-length 
path-time  time))) 

(if  path-time 

(values  path-time  path-length)))) 

;  TRACE-TRIAL-PATH-BACKWARDS  traces  the  shortest  trial-path  backvards  from 
;  TO-ADDR  to  FROH-ADDR  and  updates  the  slots  array  to  establish  the  arc. 

(defun  trace-trial -path-backsards  (from-addr  to-addr) 

(let  ((path-time  (shortest-trial -path-time  to-addr))) 

(when  path-time 

(setf  (pref  (slot-endp!!  (aref  slots[]!!  path-time))  to-addr)  t) 

(let  (slot 

trial-slot 

neighbor-no 

neighbor-addr) 

(do  ((time  path-time  (1-  time)) 

(done-p  nil)) 

(done-p  (1+  time)) 

(setf  slot  (aref  slots[]!!  time) 

trial-slot  (aref  trial-slotsC) ! !  time)) 

(setf  neighbor-no  (pref  (trial-slot-direction!!  trial-slot)  to-addr) 
neighbor-addr  (cube-from-neighbor-no  to-addr  neighbor-no) 

(prof  (slot-forvard! !  slot)  to-addr)  neighbor-no 

(prof  (slot-backward!!  slot)  neighbor-addr)  (noighbor-no-inverse  neighbor-no) 
to-addr  neighbor-addr) 

(if  (=  from-addr  to-addr) 

(setf  (pref  (slot-startp! !  slot)  to-addr)  t 
done-p  t))) 

)))) 

;  COBIECT-IODES  creates  an  arc  starting  at  FROH-ADDR  and  ending  at  TO-ADDR 
;  euid  returns  the  start  time  step  of  the  arc  in  the  source  processor. 

;  If  provided,  the  FE  ARC-LABEL  is  copied  into  the  CH  arc  label  structure 
;  at  the  start  time  in  the  source  processor. 

(defun  connect-nodes  (from-addr  to-addr  toptional  are-label) 

(flood-trial-paths  from-addr  to-addr  : inc-t ime-quemtum-p  t) 

(let  ((path-start-time  (trace-trial-path-backwards  from-addr 

to-addr) ) ) 

(if  arc-label 

(»copy-arc-label 

(slot-arc-label!!  (aref  8lots[]!!  path-start-time)) 
from-addr 
arc-label) ) 
path-start-time) ) 

;  GRAPH-SLOTS-USAGE  returns  the  percentage  of  graphs  slots  currently  used. 


87 


E.  M.  DEPRIT 


(defun  graph^slots’^usage  () 

(let  (current-slot 

(no-slots-used  0) 
total-no-slots) 

(setf  total-no-slota  (♦  * time -quant urn*  (count-css))) 
(dotimes  (time  e time-quantum*) 

(setf  current-slot  (aref  slotsC]!!  time)) 

(♦when  (not!?  (free-to-sendp ! I) ) 

(incf  no-slots-used  (count-css)))) 

(/  (*  100.0  no-slots-used)  total-no-slots))) 

: : ;  EOF 

# '  ccl 

(lormat  t  "■'y.\"Giaph  Construction\"  loaded”) 


;;;  -*-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  *LISP;  Base:  10  -•- 
(in-package  ’*lisp) 

I  >  I 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 


Tofflboulian  Implementation 
Graph  Utilities 


;  DELETE-ARC  deletes  the  graph  arc  beginning  in  the  processor  at  START-ADDR  at  START-TIME. 

(defun  delete-arc  (start-addr  start-time) 

(setf  (pref  (slot-startp ! !  (aref  slots[]!?  start-time))  start-addr)  nil) 

(let  (slot) 

(do  ((time  start-time  (1+  time)) 

(from-addr  start-addr) 

to-addr 

(done-p  nil)) 

((or  done-p  (=  time  ♦time-quantum*))) 


(setf  slot  (aref  slotsC]!!  time) 

to-addr  (cube-from-neighbor-no  from-addr 

(pref  (slot-backward??  slot)  from-addr)) 
(pref  (slot-backward ? ?  slot)  from-addr)  •neighbor-limit* 

(pref  (slot-f orward ! ?  slot)  to-addr)  *neighbor-limit* 
from-addr  to-addr) 


(if 


)) 


(pref  (slot-endp?!  slot)  to-addr) 

(setf  (pref  (slot-endp!!  slot)  to-addr)  nil 
done-p  t))) 


; ; ;  EOF 
: ccl 

(format  t  ’‘"7A"Graph  UtilitiesN"  loaded") 
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;;;  Mode:  LISP;  Syntax:  Conmon-lisp ;  Package:  eLISP;  Base:  10 
(in-package  ^♦lisp) 

;;;  Etienne  Deprit 

;;;  Va7al  Research  Lab,  Code  8242 


Tomboulian  Implementation 
Graph  Routing 


;  ROUTE-FORWARD  implements  the  forward  routing  cycle  by  looping  through  all  slot 
;  structures  in  the  time  quantum.  LABEIL-IAME  is  bound  to  the  current  CM  arc  label 
;  structure.  II-BOX!!  is  bound  to  the  in-box  pvar  of  type  II-BOX-TYPE.  At  each  time 
:  step,  ROUTE-FORWARD  calls  ARC-START-FUICTIOB  with  the  currently  selected  set  composed 
;  of  processors  at  the  beginning  of  an  arc  to  inject  new  messages  into  the  routing  cycle. 
;  ROUTE-FORWARD  also  calls  ARC-EBU-FUICTIOI  with  the  currently  selected  set  composed 
;  of  processors  at  the  end  of  an  arc  to  receive  messages. 

(defmacro  route-forward  (label-name 
in-box ! \ 
in-box-type 
arc-start -function 
arc-end-ftinction) 

(let  ((slot  (gensym)) 

(out-box! !  (gensym))) 

^(let  (, label-name) 

(•all 

(•let  (, in-box!! 

, out-box! ! ) 

(declare  (type  , in-box-type  , in-box!!  , out-box!!)) 

(map  nil 

#’ (lambda  (,3lot) 

(setf  , label-name  (slot-arc-label!!  ,8lot)) 

(•if  (slot-startp! !  .slot) 

(•set  , out-box!! 

,arc-8tart-f unction) ) 

(•when  (/=! *  (slot-forward!!  .slot)  (neighbor-limit!!)) 

(pref-neighbor ! !  , in-box!!  , out-box!!  (slot-forward!!  .slot)) 

(•set  , out-box!!  , in-box!!)) 

(♦if  (slot-endp!!  .slot) 

, arc-end-funct ion) ) 
slots[3  ! ! ) 

))) 

)) 

;  ROUTE-BACKWARD  implements  the  backward  routing  cycle  by  looping  through  aQl  slot 
;  structures  in  the  time  quantum.  LABEL-VANE  is  bound  to  the  current  CM  arc  label 
;  structure.  IB-BOI!!  is  bound  to  the  in-box  pvar  of  typo  Il-BOI-TYPE.  At  each  time 
;  step,  ROUTE-FORWARD  ceiLls  ARC-START-FUBCTIOH  with  the  currently  selected  set  composed 
;  of  processors  at  the  end  of  an  arc  to  Inject  new  messages  into  the  routing  cycle. 

;  ROUTE-FORWARD  also  calls  ARC-EBD-FUBCTIOB  with  the  currently  selected  set  composed 
;  of  processors  at  the  beginning  of  an  arc  to  receive  messages. 

(defmacro  route-backward  (label-name 

in-box ! ! 
in-box-type 
arc-start-f unction 
arc-end-funct ion) 

(let  ((slot  (gensym)) 

(out-box!!  (gensym))) 

‘(let  (.label-name) 
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(♦all 

(♦let  (, in-box!! 

, out -box! ! ) 

(declare  (type  , in-box-type  , in-box!!  ,ont-box!!)) 

(map  nil 

(lambda  (,slot) 

(setf  , label-name  (slot-arc-label!!  ,slot)) 

(♦if  (slot-endp!!  ,slot} 

(♦set  , out-box!! 

,  zo'c-start-f  unction)  ) 

(♦when  (/=! !  (alot-backuard! !  ,alot)  (neighbor-limit!!)) 

(pref-neighbor ! !  , in-box!!  , out-box!!  (slot-backward!!  ,slot)) 
(♦set  ,  out-box.*?  ,  in-box  .*  .*)) 

(♦if  (slot-startp ! !  .slot) 

, arc-end-function) ) 

(reverse  slots[]!!)) 

))) 

)) 

; ; ;  EOF 
#+ : ccl 

(format  t  "''y,\‘'Graph  Routing\’‘  loaded") 


;;;  -♦-  Kode :  LISP;  Syntax:  Common-lisp;  Package:  vLISP;  Base:  tO  -♦- 
(in-package  ^♦lisp) 

; ; ;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 


Tomboulian  Implementation 
leiiral  let  Front-End  Structures 
SLAB  set  of  units 

BUVDLE  set  of  connections  between  2  slabs  with  density  0-100% 
lET  sets  of  slabs  and  bundles, 

with  input  ft  output  slab  (possibly  the  same) 
represents  COiTIIUOUS-HAPPIIG  or  ASSOCIATIVE-HEMORY  net 


;  Slab  of  units 


(def struct 


no 

inputp 

outputp 

size 

addr 

) 


(net-slab 

t*** :  symbolics 
( ;  nam»'d) 

(:conc-name  slab-) 

(: constructor  f e-make-slab- internal) 

(: print -funct ion  print-slab) 

) 

;  slab  id 
;  input  slab? 

;  output  slab? 

;  no  of  units 

;  array  of  cube  addrs  of  units 


.  PRIIT-SLAB  prints  SLAB  on  STREAM. 
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(defun  print-slab  (slab  stream  ftoptional  depth) 

(declare  (ignore  depth)) 

(format  stream  "#<Slab  "a,  "a  iinit”  [s"  :  ;8*) 0’]>" 

(slab-no  slab)  (slab-size  slab) 

(slab-inputp  slab)  (slab-outputp  slab))) 

•,  SLAB-10!!  returns  a  slab-no-pvar  pvar  containing  the  SLAB  id  in  each  processor. 

(defmacro  slab-no!!  (slab) 

‘(the  slab-no-pvar  (!!  (slab-no  «slab)))) 

;  SLAB-IIPUTP! !  returns  a  boolean  pvar  containing  T  if  SLAB  is  the  input  slab. 

(defmacro  slab-inputp!!  (slab) 

‘(the  boolean-pvar  (!!  (slab-inputp  .slab)))) 

;  SLAB-OUTPUT!!  returns  a  boole2ui  p^ar  containing  T  if  SLAB  is  the  output  slab. 

(defmacro  slab-outputp!!  (slab) 

‘(the  boolean-pvar  (!!  (slab-outputp  .slab)))) 

;  Bundle  of  connections 


(defstruct  (net-bundle 

: symbolics 
( : named) 

(: cone-name  bundle-) 

(  :  constructor  fe-m2Jce-bundle- internal) 
(: print -function  print-bundle) 

) 


no 

to-slab 

from-slab 

density 

size 

to -no 
from-no 
start-time 
) 


bundle  id 

connections  to  slab 
connections  from  slab 
density  of  connections.  0-100*/. 
no  of  connections 
connection  *  (to* no, from-no) 
array  of  to-sIab  unit  ids 
array  of  from-slab  unit  ids 
start  time  step  of  connections 


;  PRIIT-BUIOLE  prints  BUIDLE  on  STREAM. 

(defun  print-bundle  (bundle  stream  toptional  depth) 

(declare  (ignore  depth)) 

(format  stream  "#<Bundle  *a  <-  "a,  *a*/,>" 

(slab-no  (bundle-to-slab  bundle)) 

(slab-no  (bundle-f rom-slab  bundle)) 

(bundle-density  bundle))) 

;  BUHDLE-BO!!  returns  a  bundle-no-pvar  pvar  containing  the  BUIDLE  id  in  each  processor. 

(defmacro  bundle-no!!  (bundle) 

‘(the  bundle-no-pvar  (!!  (bundle-no  .bundle)))) 

;  leured.  net 


(defstruct  (neural-net 

t+  rsymbolics 
( : named) 

(:conc-name  net-) 

(  :  constructor  fe-make-net-intemal) 

( .print -func tion  print-net) 

) 

name 

type  ;  COITIIOUS-HAPPIIG  or  ASSOCIATIVE-MEMORY 

(allocation-mode  :grid-center)  ;  allocation  mode  for  slabs 

slabs  ;  array  of  slabs 
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input-slab-no 
output-slab-no 
bundles 
no -units 
no-connections 
no-processors 

(a  1.0) 

(b  1.0) 

(eta  0.25) 

(alpha  0.9) 

^'epsilon-x  0.001) 

<x-iterations  4) 
lepsilon-y  0.001) 

(y-iterations  4) 

(epsiloii-u  0.1) 

(mar-updates  10000) 

) 

;  PRIIT-IET  prints  WET  on  STREAM. 

(defun  print-net  (net  stream  ^optional  depth  ftkey  verbose-p) 

(declare  (ignore  depth)) 

(if  (not  verbose-p) 

(format  stream 

"t<Iet  "a  'a  slab"  :  [s" ; ;  s“]  ,  'a  bundle"  [s" s"]  >'* 

(net-name  net) 

(length  (net-slabs  net)) 

(length  (net-bundles  net))) 

(format  stream  "*y,"a  net:  "a"  (net-type  net)  (net-name  net)) 

(format  stream  ""2*/,*a  slab*  ;  [s*  ;  *  :  ; s"]  ,  *a  bundle*  :•* [s*  s*] '* 

(length  (net-slabs  net))  (length  (net-bundles  net))) 

(format  stream  "*y,*a  unit*  :•*  [s*  ;  *  :  ;s*]  ,  *a  connection*  :**  [s*  ;*:; s*]  ->* 

*a  processor* :♦* Ca* ;*: ;8*] " 

(net-no-units  net)  (net-no-connections  net)  (net-no-processors  net)) 
(format  stream  •**2y«a  *  *a,  b  *  *a"  (net-a  net)  (net-b  net)) 

(format  stream  "*2y,Feed-foreard  convergence  *  *a,  min  *a  iteration*  [s*  ;*:; s*] " 

(net-epsilon-x  net)  (net-x-iterations  net)) 

(format  stream  ""'/.Back-propagate  convergence  =  *a,  min  *a  iterat ion*  : ♦*  [s* ;  *  : ;  s*]  " 
(net-epsilon-y  net)  (net-y-iterations  net)) 

(format  stream  "*2y,eta  =  *a,  alpha  =  *a"  (net-eta  net)  (net  alpha  net)) 

(format  stream  "*yWeight  update  convergence  *  *a,  max  *a  iteration* [s* ;*: ;s*] " 
(net-epsilon-v  net)  (net-max-updates  net)) 

(terpri  stream))) 

;  GET-SLAB  returns  the  slab  with  id  SLAB-IO  in  MET. 

(defmacro  get-slab  (net  slab-no) 

^(curef  (net-slabs  ,net)  , slab-no)) 

;  GET-IIPUT-SLAB  returns  the  input  slab  in  MET. 

(defmacro  get-input-slab  (net) 

'(aref  (net-slabs  ,net)  (net-input-slab-no  ,net))) 

;  GET-OUTPUT-SLAB  returns  the  output  slab  in  RET. 

(defmacro  get-output-slab  (net) 

^(aref  (net-slabs  ,not)  (net-output-slab-no  ,not))) 

;  GET-BUIDLE  returns  the  bundle  with  id  BUIDLE-IO  in  lET. 

(defmacro  get-bundle  (net  bundle-no) 

‘(aref  (net-bundles  ,net)  , bundle-no)) 

;  HEHORY-IETP  returns  T  if  lET  is  an  ASSOCIATIVE-MEMORY  net. 


;  input  slab  id 
;  output  slab  id 
;  array  of  bundles 
;  total  number  of  units 

;  connections 

;  processors 

;  dynamical  system  equation  constants 

;  learning  rate 
;  momentum  term 

;  feed-forward  convergence  criterion 
;  min  iterations  before  convergence  test 
;  back-propagate  convergence  criterion 
;  min  iterations  before  convergence  test 
;  weight  update  convergence  criterion 
;  max  weight  updates  in  training 
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(defmacro  nemorj-netp  (net) 

‘(eq  (net-type  ,net}  ’associatiTe-memory)) 

;  ; ;  EOF 

#+; ccl 

(format  t  "■‘/A"Iet  FE  StructuresX"  loaded") 


;;;  Mode:  LISP;  Syntax:  Common-lisp;  Package:  ‘LISP;  Base:  10  -*- 
(in-package  ’‘lisp) 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 


;;  Tomboulian  Implementation 
; ;  let  CH  Structures 


;  Units 


(•proclaim  ’(type  boolean-pvar 
(•proclaim  ’(type  boolean-pvar 
(•proclaim  ’(type  boolean-pvar 
(•proclaim  ’(type  slab-no-pvar 
(•proclaim  ’(type  unit-no-pvar 


unitp: !)) 
inputp! !)) 
outputp! !)) 
slab-no! !)) 
unit-no! !)) 


(•defvar  unitp!!  nil!!) 
(•defvar  inputp!!  nil!!) 
(•defvar  outputp!!  nil!!) 
(•defvar  slab-no!!) 
(•defvar  unit-no!!) 


;  processor  is  net  unit? 
;  input  unit? 

;  output  unit? 

;  unit  slab  id 
;  unit  id 


;  Variables  appearing  in  feed-fomard  and  back-propagation  equations 


( •proclaim 
(•proclaim 
(•proclaim 
(•proclaim 
(•proclaim 
(•proclaim 
(•proclaim 
(•proclaim 
(•proclaim 
(•proclaim 
(•proclaim 
(•proclaim 


’ (type 
’(type 
’ (type 
’ (type 
’ (type 
’ (type 
’ (type 
’ (type 
’ (type 
’ (type 
’ (typo 
’ (type 


single-float-pvar 
single-float-pvar 
single-f loat-pvai 
single-float-pvar 
single-float-pvar 
single-float-pvar 
single-float-pvar 
single-float-pvar 
single-float-pvar 
single-float-pvar 
single-float-pvar 
single-float-pvar 


a!!)) 
b!!)) 
I!!)) 
Z!!)) 
dX! !)) 
U!!)) 
LogU ! ! ) ) 
I!!)) 

Y  ! !  )  ) 
dY! !)) 
V!!)) 
J!!)) 


(•defvar  a!!) 

( vdefvar  b! ! ) 
(•defvar  I! ! ) 
(•defvar  I!  !) 
(•defvar  Z! ! ) 

( vdefvar  dX ! ! ) 
(•defvar  U! !) 
(•defvar  LogU! ! ) 
(•defvar  I ! ! ) 
(•defvar  Y! ! ) 
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(•defvar  dY! !) 

(*defvar  V! ! ) 

(♦defvar  J ! * ) 

(♦proclaim  ^(type  single-float-pvar  epsilon-r ! ! ) ) 
(♦proclaim  ’(type  single-float-pvar  epsilon-y ! !)) 
(♦proclaim  ’(type  single-float-pvar  epsilon-w ! ! ) ) 


(♦defveir  epsilon-x!!) 

(♦defvar  epsilon-y!!) 

(♦defvar  epsilon-e!!) 

(♦proclaim  ’(type  single-float-pvar  eta!!)) 
'♦proclaim  ’(type  single-float-pvar  alpha!!)) 

(♦defvar  eta! !) 

(♦defvar  alpha!!) 

;  Connections 

;  Define  arc  labels  for  net  connections 


(def-arc-label  connection 

(W  nil  ’weight  single-float-pvar) 

(dW  nil  ’dW  single-float-pvar) 

(dVold  nil  ’dWold  single-float-pvar) 

) 

; ; :  EOF 
*+ ; ccl 

(format  t  let  StructuresV’  loaded") 


;  feed-forward  convergence  criterion 
;  back-propagate  convergence  criterion 
;  weight  update  convergence  criterion 


;  learning  rate 
;  momentum  term 


;  connection  weight 
;  current  gradient 
;  previous  gradient 


-♦-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  ^LISP;  Base:  10  -♦ 
( in-package  ’ ♦lisp) 


Etieiine  Deprit 

■aval  Research  Lab,  Code  8242 


T'  'loulian  Implementation 
Hake  Bet  Structures  on  Front-End 


;  Front-End  slab  structure 

;  FE-HAKE-SLAB  returns  a  net  slab  of  SIZE  units  with  id  BO.  liPUTP  and  OUTPUT? 

;  indicate  if  this  slab  is  the  input  or  output  slab,  respectively. 

(defun  fe-make-slab  (no  size  inputp  outputp) 

(f e-make-slab-intemal  :no  no 

:size  size 
: inputp  inputp 
: outputp  outputp)) 

;  Front-End  bundle  structure 

;  RAIDOH-COIIECTIOIS  returns  ROW  number  and  COL  number  arrays  representing  a  bundle 
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;  of  connections  to  a  slab  of  TO-SIZE  units  from  a  slab  of  FRON-SIZE  units. 

;  Each  possible  connection  is  formed  with  probability  given  by  DEISITY. 

(defun  random-connections  (to-size  from-aize  density) 

(let  (n  row  col) 

(setf  density  (/  density  100.0)) 

(♦all 

(♦let  ((rendezvous!!  (!!  0))) 

(declare  (type  cube-address-pvar  rendezvous!!)) 

(♦when  (and!!  (<!!  (self -address ! ! ) 

(the  max-int-pvar  (!!  (♦  to-size  from-size) ) ) ) 

(<!!  (random-float!!  (!!  0.5)  (!!  0.5)) 

(the  float-pvar  (!!  density)))) 

(setf  n  (count-css)) 

(♦pset  :no-collisions 

(self-address ! ! ) 
rendezvous ! ! 

(enumerate! !))) 

(setf  roe  (make-array  n) 
col  (make-array  n)) 

(pvar-to-array  (truncate!!  rendezvous!!  (!!  from-size)) 
roe 

: cube-address-end  n) 

(pvar-to-array  (mod!!  rendezvous!!  (!!  from-size)) 
col 

: cube-address-end  n))) 

(values  roe  col))) 

;  FE-MARE-BUHDLE  returns  a  bundle  with  id  10  connecting  TO-SLAB  and  FROM-SLAB 
;  with  the  probability  of  each  connection  given  by  DEISITY. 

(defun  fe-m^Jle- bundle  (no  to-slab  from-slab  density) 

(let  ((bundle  (f e-maike-bundle-internal 
.no  no 

:to-slab  to-slab 
; from-slab  from-slab 
tdensity  density))) 

(mvj.tiple-value-setf 
((bundle-to-no  bundle) 

(buna.l  i-from-no  bundle)) 

(random-connections  (slab-size  to-slab) 

(slab-size  from-slab) 
density)) 

(setf  (bundle-size  bundle)  (length  (bundle-to-no  bundle))) 
bundle) ) 

;  Front-End  net  structure 

;  A  bundle  spec  is  a  list  of  the  form  (<to  slab  id>  <from  slab  id>  <den8ity>) . 

(defstruct  (bundle-spec 

( : type  list) ) 

to-slab 

from-slab 

density) 

:  FE-MAKE-HET  returns  the  net  lANE  of  the  given  TYPE  (COITIIOUS-HAPPIIG  or 
;  ASSOCIATIVE-MEMORY).  SLABS  must  be  a  list  of  total  units  in  each  slab,  and 
;  IHPUT-SLAB-IO  and  OUTPUT-SLAB-iO  identify  the  input  and  output  slabs, 

;  respectively.  BUIDLES  must  be  a  list  of  bundle  specifications.  Additional 
;  keyword  arguments  are  passed  in  to  FE-HAKE-IET-IfTERIAL  allowing  other 
;  net  parameters  to  be  set. 

(defun  fe-make-net  (name  type  slabs  input-slab-no  output-slab-no  bundles 
ftrest  other-net-keys  tkej  ftallow-other-keys) 

(let  ((net  (apply  #’fe-make-net-internal 
:name  (string  name) 

:type  type 

: input-slab-no  input-slab-no 
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toutput-slab-no  output -slab-no 
other-net-lceys))) 

(let  ((slab-no  -1)) 

(setf  (net-slabs  net) 

(map  ’array 

t’dambda  (slab-cizc) 

(f e-ma}ce-slab  (incf  slab-no) 
slab-size 

(eq  input-slab-no  slab-no) 

(eq  output-slab-no  slab-no))) 

slabs))) 

(let  ((bundle-no  -1)) 

(setf  (net-bundles  net) 

(map  ’array 

*’ (lambda  (bundle) 

(f e-make-bundle  (incf  bundle-no) 

(get-slab  net  (bundle-spec-to-slab  bundle)) 
(get-slab  net  (bundle-spec-from-slab  bundle)) 
(bundle-spec-density  bundle))) 

biindles) ) ) 

(f  e-size-net  net) 
net)  ) 

;  FE-SIZE-IET  sets  the  total  number  of  units,  connections  and  processors  required  by  NET. 

'efun  fe-size-net  (net) 

(setf  (net-no-units  net) 

(reduce 

(map  ’list  • ’slab-size  (net-slabs  net))) 

(net-no-connections  net) 

(reduce  t’+ 

(map  ’list  t’bundle-size  (net-bundles  net))) 

(net-no-processors  net) 

(net-no-units  net))) 

;  COSTIHUOUS-MAPPIIG  net 

;  DEF-HAPPIBG-BET  returns  a  COBTIIUOUS-MAPPIIG  net  called  BAKE  specified  by 
;  the  keyword  argguments  SLABS,  IBPUT-SLAB-BO ,  OUTPUT-SLAB-BO  and  BUNDLES. 

;  Additional  keyword  arguments  can  be  used  to  specify  other  net  parameters. 

(defmacro  def-mapping-net  (nsuae  Brest  other-net-keys 

Bkey  slabs  input -slab-no  output-slab-no  bundles 
tallow-other-keys) 

‘ (progn 

(defvar  ,naffle) 

(setf  ,name  (fe-make-net  ’ ,name 

’ c  ont inuous-mapp ing 
, slabs 

, input-slab-no 
, output-slab-no 
.bundles 

,Bother-net-keys) ) 

( cm-net -cold-boot  ,name) 

(cm-make-net  ,name))) 

,  ASSOCIATIVE-MEMORY  net 

:  DEF-MEMORY-BET  returns  an  ASSOCI ATIVE-MEMORY  net  called  NAME  specified  by 
;  the  keyword  argguments  SLABS,  IBPUT-SLAB-IO  and  BUNDLES.  Additional  keyword 
;  arguments  can  be  used  to  specify  other  net  parameters. 

(defmacro  def -memory-net  (name  Brest  other-net-keys 

Bkey  slabs  input-slab-no  bundles 
Ballow-other-keys) 

^ (progn 

(defvar  .name) 

(setf  ,najne  (fe-make-net  ’  .name 

’ assoc iat ive-memory 
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, slabs 

i\put-slab-no 
, input-slab-no 
(bundles 

, •other-net -keys)) 

(cm-net -cold-boot  (name) 

(cm-m2Ute-net  (name))) 

; ; :  EOF 

#+ ; ccl 

(format  t  "“y.\"FE  Hake  letX"  loaded") 


1 

I 


;;;  Mode:  LISP;  Syntax:  Common-lisp;  Package:  eLlSP;  Base:  10 
(in-package  ’♦lisp) 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab(  Code  8242 


Tomboulian  Implementation 
Make  let  Structures  on  CM 


;  CM  slab  structure 

;  CH-KAKE-SLAB  creates  the  structure  for  SLAB  on  the  CM  according  to  ALLOCATIOI-MODE . 

(defun  cffl-make-slab  (slab  allocation-mode) 

(let  ((slab-size  (slab-size  slab))) 

(eith-n-proc-allocated  (slab-size  slab-addr  allocation-mode) 

(setf  (slab-addr  slab)  slab-addr) 

(♦set  onitp! ?  t ! ! 

inputp!!  (slab-inputp! !  slab) 
outputplf  (slab-outputp! ?  slab) 
slab-no!!  (slab-no!!  slab) 
unit-no f  ?  (enumerate! !)))) 

slab) 

;  CM  bundle  structure 

;  CH-HAaE-BUIDLE  creates  the  structure  for  BUIDLE  on  the  CM. 

(defuii  cm-make-bundle  (bundle) 

(let  ((to-addr  (slab-addr  (bundle-to-slab  bundle))) 

(from-addr  (slab-addr  (bundle-f rom-slab  bundle)))) 

(setf  (bundle-start-time  bundle) 

(map  ’array  t’ (lambda  (from-no  to-no) 

(connect-nodes  (aref  from-addr  from-no) 

(aref  to-addr  to-no))) 

(bundle-from-no  bundle) 

(bundle-to-no  bundle)))) 

bundle) 

;  CM  net  structure 

;  CH-IET-COLD-BOOT  cold  boots  the  vith  the  dimensions  necessary  for  lET. 

(defun  cm-net-cold-boot  (net) 

(let  ((cm-dims  (cm-best-f it-dims  (net-no-processors  net)))) 

(or  cm-dims 

(error  "let  'a  too  large  for  (JH"  (net-name  net))) 
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(«cold*boot  :  Initial'dimexisionB  cm'diMs))) 

;  CN-NiFE-lEP  craatBs  the  structure  for  VET  on  the  CH. 

(defun  cB-make-net  (net) 

(aap  nil  f’daabda  (slab) 

(cB^ake-slab  slab  (net-allocation*Bode  net))) 
(net-slabs  net)) 

(map  nil  fUla&bda  (bundle) 

(cB-aake-bundle  bundle)) 

(net-bundles  net)) 

(•all 

(*ehen  unitp! ! 

(•set  a!!  (the  float-pvar  (!!  (net-a  net))) 
b!!  (the  float-pvar  (!!  (net-b  net))) 
epsilon-x! !  (the  float-pear  (!!  (net-epsilon-x  net))) 
epsilon-y!!  (the  float-pear  (!!  (net-epsilon-y  net))) 
epsilon-u! !  (the  float-pear  (!!  (net-epsilon-e  net))) 
eta!!  (the  float-pear  (!!  (net-eta  net))) 
alpha!.'  (the  float-pear  (!!  (net-alpha  net)))))) 
(cm-reset -Heights) 
net) 

;  CM-RESET-WEIGHTS  resets  the  Heights  for  each  connection  in  the  net 
;  to  a  randoa  float  in  the  intereal  [mean-intereal  «  mean'** int ere al]  . 

(defun  cm-reset-seights  (toptional  (nean  0.0)  (intereal  0.5)) 

(f OT-all-arc-starts  (connection! !) 

(♦set  (connection-W! !  coniiection!  !) 

(randoB-float ! ! 

(the  float-pear  (!!  mean)) 

(the  float-pear  <!!  intereal)))))) 

; ; :  EOF 
t+;ccl 

(format  t  Make  Vet\"  loaded'  ) 


;;;  Mode:  LISP;  Syntax:  Common-lisp;  Package:  *115?;  Base:  10  -•- 
(in-pac)cage  ’elisp) 

;;;  Etienne  Deprit 

,,,  laval  Research  Lab,  Code  8242 


Tomboulian  Implementation 
CM  Vet  Access 


Slab  Access 


;  GET-SLAB-PVAR  returns  an  array  containing  the  values  of  PVAR 
;  for  the  slab  sith  id  SLAB-10  in  VET. 

(defun  get-slab-pear  (net  slab-no  pear) 

(let  ((slab  (get-slab  net  slab-no))) 

(•all 
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(♦let  (nail-box!!) 

(•Hhen  (and!!  unitp! !  (*!!  slab-no!!  (slab-no!*  slab))) 

(♦pset  ino-collisions  pvar  nail-box!!  (enuaerata! ! )) 
(pvar-to-array  nail-box!!  (nake-array  (slab-sixa  slab)) 

: cube-address-end  (count-css) )))))) 

;  GET-SLIB-X  returns  an  array  containing  the  salues  of  Xf! 

;  for  the  slab  vith  id  SLAB-IO  in  lET. 

(defmacro  .get-slab-X! !  (net  slab-no) 

* (get-slab-pvar  ,net  , slab-no  X!!)) 

;  GET-IET-OUTPUT  returns  an  array  containing  the  output  values  of  lET. 

(defniacro  get-net-output  (net) 

‘(get-slab-X!!  ,net  (net-output-slab-no  ,net))) 


Bundle  Access 


;  GET-BUIDLE-V  returns  an  array  containing  the  values  of  U!! 
;  for  the  bundle  sith  id  BUIDLE-IO  in  MET. 

(defun  get-bundle-W! !  (net  bundle-no) 

(letv  ((bundle  (get-bundle  net  bundle-no)) 

(from-slab  (bundle-froB-slab  bundle)) 

(from-addr  (slab-addr  from-slab)) 

(from-no  (bundle-from-no  bundle)) 

(start-time  (bundle-start-time  bundle)) 

(U  (make-array  (bundle-size  bundle)))) 

(dotimes  (c  (bundle-size  bundle)) 

(setf  (aref  V  c) 

(pref  (aref  slots []! !  (aref  start-time  c)) 

(aref  from-addr  (aref  from-no  c))))) 

)) 

;;;  EOF 
t+ ;ccl 

(format  t  let  AccessV"  loaded") 


;;;  -♦-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  vLISP;  Base:  10 
(in-package  ^*lisp) 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 


;;;  Tomboulian  Implementation 
; ; ;  Training  Sets 

;  Training  Examplar 

(defstruct  (examplar 

( ;type  list)) 

input-pvar 

input-vec 
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target-p»»r 

target-»ec) 

Training  Sat 

(dafstruct  (training-sat 

(:tjpa  list)) 

typa  ;  HiPPIlQ-SET  or  MEMORY-SET 

nana 

axamplars)  ;  list  of  axanplars 

;  GET-EIIMPLAR  returns  the  exanplar  with  id  EX4MPL1R  -10  in  TRillllG-SET. 

i.aefmacro  get-exanplar  (training-set  exajq>lar-no) 

(nth  .examplar-no  (training-sat-exajnplars  .training-sat))) 

;  GM-LOAD-TRAIIIiG-PAIR  loads  the  liPUT/TARGET  training  rectors  into  the 
;  CORTIIUOUS-MAPPIIG  net  structure  on  the  CM  and  returns  an  exanplar 
;  containing  the  IIPUT  and  TARGET  rectors.  The  prars  corresponding 
;  to  the  training  pair  are  marked  with  the  giren  SET-IAME  and  PAIR-IO. 

(defun  cm-load-training-pair  (set-name  pair-no  input  target) 

(»all 

(let  ((input!!  (allocate!!  nil 

(format  nil  "*a-"a-I"  set-name  pair-i.o) 
’float-prar) ) 

(target!!  (allocate!!  nil 

(format  nil  ""a-'a-T"  set-name  pair-no) 
’float-prar) ) ) 

(♦let  (mail-box!!) 

(declare  (type  float-prar  nail-box!!)) 

(array-to-pvar  input  mail-box!!  : cnbe-addrass-end  (length  input)) 

(•when  inputp!! 

(♦set  (the  float-prar  input!!) 

(prof!!  mail-box!!  unit-no!!  : collision-mode  :no-collisions))) 
(array-to-prar  target  mail-box!!  : cube-address -end  (length  target)) 
(•when  outputp.! 

(♦set  (the  float-prar  target!!) 

(pref!!  mail-box!!  unit-no!!  icollision-mode  :no-collisions) ) ) ) 
(list  input!!  input  target!!  target)))) 

;  CM-LOAD-MAPPIIG-SET  loads  the  TRAIIIIG-PAIRS  labeled  SET-IAME  into  the 
:  COITIIUOUS-MAPPIIG  net  structure  on  the  CM  and  returns  the  resulting 
;  training  set.  TRAIIIIG-PAIRS  must  be  a  list  of  input/target  rector  lists. 

(defun  cm-load-mapping-set  (set-name  training-pairs) 

(let  ((pair-no  -1)) 

(list  'mapping-set  set-name 

(mapcar  t’ (lambda  (pair) 

(cm-load-training-pair  set-name 

(incf  pair-no) 

(first  pair) 

(second  pair))) 

training-pairs)))) 

;  CM-LOAD-MEMORY-IIPUT  loads  the  IIPUT  rector  into  the  COITIIUOUS-MAPPIIG 
;  net  structure  on  the  CM  and  returns  an  exemplar.  The  prar  corresponding 
;  to  the  liPUT  rector  is  marked  with  the  giren  SET-IAME  and  IIPUT-IO . 

(defun  cm-load-memory- input  (set-name  input-no  input) 

(♦all 

(let  ((input!!  (zdlocate!!  nil 

(format  nil  ""a-'a-I"  set-name  input-no) 
’float-prar))) 

(♦let  (mail-box!!) 

(declare  (type  float-prar  mail-box!!)) 

(array-to-prar  input  mail-box!!  :cubo-addre8S-end  (length  input)) 

(•when  inputp!! 

(♦set  (the  float-prar  input!!) 
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(prof!!  mail-box!!  imit-no!!  : collision-mode  :iio-colli8ions)))) 
(list  input!!  input  input!!  input)))) 

;  CM-LOiD-HEMORY-SET  loads  the  TRAIIIIG-LIST  labeled  SET-IIME  into  the 
:  COITIIOUS-HAPPIIG  net  structure  on  the  CH  and  returns  the  resulting 
;  training  set.  The  TRillllC-LIST  must  be  a  list  of  input  vectors. 

(defun  cm-load-memory-set  (set-name  training-set) 

(let  ((input-no  -1)) 

(list  ’memory-set  set-name 

(mapcar  t’ (lambda  (input) 

(cm-load-memory-input  set-name 

(incf  input-no) 
input)) 

training-set) ) ) ) 

;  CM-UILOAD-TRillllG-SET  unloads  TRIIIIIG-SET  from  the  COITIIUOUS-MAPPIIG  or 
;  ASSOCIATIVE-HEMORY  net  structure  on  the  CM.  The  pvars  in  the  TRAIIHG-SET 
,  array  are  deallocated  and  should  no  longer  be  accessed. 

(defun  unioad-training-set  (training-set) 

(let  ((type  (training-set-type  training-set))) 

(map  nil 

t’ (lambda  (examplar) 

(edeallocate  (examplar- input-pvar  examplar)) 

(if  (eq  type  ’mapping-set) 

(•deallocate  (exampl2ir-target-pTar  examplar)))) 
(training-set-examplars  training-set)))) 

;  PRIIT-TRAIIIIG-SET  prints  the  TRAIlIIG-SET’s  input/target  or 
;  input  vectors  for  a  MAPPUG-SET  or  MEMORY-SET,  respectively. 

(defun  print-training-sat  (training-set) 

(let  ((type  (training-set-type  training-sat))) 

(format  t  ""S/C'a:  *a"  typo  (training-set-name  training-sot)) 

(map  nil 

t’ (lambda  (examplar) 

(format  t  ""Xi:  ")  (print-vec  (examplar- inpnt-vec  examplar)) 

(ehen  (eq  type  ’ouipping-set) 

(format  t  "  t;  ")  (print-vec  (examplar-target-vec  examplar)))) 
(training-set-exas^lars  training- set)))) 

: ; ;  EOF 

f+'.CCl 

(format  t  "■7,\"Training  Sats\"  loaded") 


;;;  -•-  Mode:  LISP;  Syntax:  Common-lisp;  Package:  *LISP;  Base:  10  -*- 
(in-package  ’»lisp) 

;;;  Etienne  Deprit 

;;;  laval  Research  Lab,  Code  8242 

;;;  Tomboxilian  Implementation 
; ; ;  let  Learning 

;  DEBOC-LEARfllG  sets  toggles  the  :IET-0EBUG  flag  in  the  features  list. 
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(defun  debug-leaming  (toptional  (debug-on  t)) 

(if  debug-on 

(pushnee  ;net-debng  efeatures*) 

(self  efeatures*  (delete  :net-debug  efeaturea*)))) 

;  Scalar  LOGISTIC  function 

(defun  logistic  (x) 

(/  (1+  (exp  (-  x))))) 

;  Parallel  LOGISTIC  function 

' ’efmacro  logistic!!  (x!!) 

'<'/!!  (the  single-float-pvar  (1+!!  (exp!!  (-!!  ,x! !)))))) 

;  Scalar  LOGISTIC  derivative 

(defun  dLogistic  (x) 

(let  ((logistic  (logistic  x))) 

(»  logistic  (-  1  logistic)))) 

;  Parallel  LOGISTIC  derivative 

(defmacro  dLogistic!!  (x!!) 

(let  ((logistic!!  (gensym))) 

'(»let  ((.logistic!!  (logistic!!  ,x!!))) 

(declare  (type  single-float-pvar  .logistic!!)) 

(•!!  .logistic!!  (-!!  (!!  1)  .logistic!!)))) 

) 

;  *IQRM  of  pvar 

(defmacro  ‘norm  (x!!) 

‘(sqrt  (*sum  (•!!  ,x!!  .x!!)))) 


Feed-f oreard 


;  FEED-FORWARD  computes  a  single  feed-forward  cycle  of  lET  with  the  given  IIPUT 
;  If  lET  is  an  ASSOCIITIVE-MEHORY  net  and  LATCHED-P  is  T.  then  FEED-FORWARD 
■,  operates  on  the  master  network  rather  than  the  slave  network. 

(defun  feed-forward  (net  input!!  tkey  latched-p) 

(♦all 

(♦when  unitp! ! 

(♦set  I! !  (!  !  0.0) 

I!  !  (! !  0.5) 
dl! !  ( ! !  O.S)) 

(♦when  inputp! ! 

(if  (memory-netp  net) 

(♦set  I!!  (the  single-float-pvar  input!!)) 

(♦set  I!!  (the  single-float-pvar  input!!)))) 

(♦set  Z! !  I! !) 

(do  () 

((♦and  (<!!  (abs!!  dl! !)  epsilon-x ! ! ))) 

(dotimes  (i  (net-x-iterations  net)) 

#+: net-debug 
(progn 

(format-pvars  (U!!  LogU!!  dX ! !  X!!  Z!!)) 

(format  t  "'KHit  any  key  to  continue:  ")  (read-char)) 

(♦set  U! !  (! !  0.0)) 

(route-forward  connection!!  WZi!!  single-float-pvar 

(♦!!  Z!!  (connect ion-W! !  connection ! ! )) 
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(*set  0! !  (+! !  U! !  WZi! !))) 

(•set  LogU!!  (logistic!!  U!!) 

dX!!  (+!!  (•!!  a!!  (-!!  I!!))  (♦!!  b! !  LogU!!)  I!!) 
X!  !  (+!  !  X! !  dX!  !) 

Z! !  X! !) 

(if  latched-p 

(•Hhen  inputp! ! 

(•sot  Z!!  (the  single-float-pvar  input!!)))) 

)) 

))) 


BacX-Propagate 


;  BiCK-PROPAGATE  computes  a  single  back-propagation  cycle  of  lET  »ith  the  given  TARGET!!. 

(defun  back-propagate  (net  target!!) 

(•all 

(•when  unitp! ! 

(•if  outputp!! 

(•set  J!!  (-!!  (the  s ingle-float -pvar  target!!)  X!!)) 

(•set  J! !  ( ! !  0.0))) 

(•set  Y! !  (! !  0.0) 

dY! !  ( ! !  0.5)) 

(do  (,' 

((•and  (<!!  (abs!!  dY!!)  epsilon-y! !))) 

(dotimes  (i  (not-y-iterations  net)) 

#+ ;net-debug 
(progn 

(format-pvars  (LogU!!  V!!  dY!!  Y!!)) 

(format  t  "'XHit  any  key  to  continue:  ”)  (read-char)) 

(•set  V!  !  (!  !  0.0)) 

(route-backward  connection!!  Yj!!  single-float-pvar 
Y!  ! 

(•set  V!!  (+!!  V!!  (*! !  Y j ! !  (connection-W ! !  connection!!))))) 
(if  (memory-netp  net) 

(•when  inputp! ! 

(•set  V! !  (! !  0.0)))) 

(•set  dY!!  (+!!  (•!!  a!!  (-!!  Y!!)) 

(•!!  b!!  LogU!!  (-! !  (!!  1.0)  LogU!!) 

(+!!  V!!  J!!))) 

Y ! !  (+ ! !  Y ! !  dY ! ! ) ) 

)) 


Gradient  Update 


;  GRADIEIT-UPDATE  increments  the  current  weight-space  gradient, 
(defun  gradient-update  () 

(route-backward  connection!!  Yj!!  single-float-pvar 
Y!  ! 

(•set  ( connect ion-dW ! !  connection!!) 

(+!!  (connect ion-dW ! !  connection!!) 

(•! !  Yj I !  Z! !))))) 


;  Weight  Update 

;  WEIGHT-UPDATE  updates  the  connection  weights  using  the  current  and  last  gradients. 

(defun  weight-update  () 

(for-all-arc-starts  (connection! !) 
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(«8et  (connect ion-V ! !  connection!!) 

(+!!  (connect ion-V ! !  connection!!) 

(*!!  eta!!  (connect ion*dU ! !  connection!!)) 

(♦!!  alpha!!  ( connect ion-dVold ! !  connection!!))) 
(connection-dVold! !  connection! !) 

(connect lon-dW ! !  connection!!)) 

)) 


let  Training 


;  STEEPEST-DESCEIT  performs  a  true  steepest-descent  adjustment  of  the  connection  weights 
,  for  the  input/target  pairs  in  TRAIIIIG-SET .  STEEPEST-DESCEIT  returns  T  or  IIL 
;  indicating  if  TRAIMIIG-SET  has  been  learned  within  the  weight  update  criterion  and 
,  the  current  target  error.  If  provided,  the  PRIIT-IET-IO  function  is  called  to  report 
;  the  net’s  input  and  output. 

(defun  steepest-descent  (net  training-set  they  print-net-io) 

(let  (deamed-p  t) 

(target-error  0.0)) 

(•all 

(for-all-arc-starts  (connection! ?) 

(•set  ( connect ion-dtf ! !  connection!!)  (!!  0.0))) 

(dolls t  (ezamplar  (training-set-eramplars  training-set)) 

(feed-forward  net  (eiamplar-input-pvar  examplar)  :latched-p  (memory-netp  net)) 
(back-propagate  net  (ezamplar-target-pvar  examplar)) 

(•when  outputp!! 

(setf  learned-p 

(and  learncd-p 

(•and  (<!(  (abs!!  J!!)  epsilon-w! !)))) 

(incf  target-error  (•norm  J!!))) 

(if  print-net-io 

(funcall  print-net-io  (examplar-input-vec  examplar)  (get-net-output  net))) 
(gradient-update) ) 

(weight-update)) 

(values  learned-p  target-error)) 

) 

;  TRAIf-IET  trains  lET  using  the  given  TRAIillG-SET.  If  specified,  PRIRT-TRAIBIHG-SET 
;  is  called  to  print  the  current  TRAIIIIG-SET.  In  addition,  PRIIT-IET-IO  may  be  used 
;  to  report  the  net’s  input  and  output  each  PRIIT-IITERVAl  iterations. 

(defun  train-net  (net  training-set  tkey  print-training-set  print-interval  print-net-io) 
(format  t  '’“2*/.Iet  Training"*/,") 

(print-net  net  t  nil  rverbose-p  t) 

(if  print-training-set 

(funcall  print-training-set  training-set)} 

(•all 

(for-all-arc-starts  (connection! !) 

(•set  (connection-dWold! !  connection!!)  (!!  0.0)))) 

(do  ((iteration  0  (1+  iteration)) 

(learned-p  nil) 
target-error 

(print-net-io-p  print-interval 

(and  print-interval 

(zerop  (mod  (1+  iteration)  print-interval))))) 


((or  learned-p 

(and  (net-max-updates  net) 

(»  iteration  (net-max-updates  net)))) 
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(format  t  "*’2y,Trainiiig  set  :  [not  ";*3leamed  after  "a  iterat  ion' :  [s’ ;  "  :  ;  s']  .  “V." 

leamed'p  iteration) 

(when  (emd  print-interval  print-net-io) 

(map  nil  (lambda  (exan^lar) 

(feed-forward  net  (exemplar- input -pvar  exemplar)) 

(funcall  print-net-io 

(examplar-input-vec  exaaplar) 

(get-net-output  net))) 

(training-set-examplars  training-set)) 

(format  t  "'7,Error  =  "a"  target-error))) 

(if  print-net-io-p 

(format  t  "*’2Xlteration  'a**  iteration)) 

(multiple- value-setf 

(learned-p  target-error) 

(steepest-descent  net 

training-set 

:print-net-io  (if  print-net-io-p  print-net-io))) 


(if  print-net-io-p 

(format  t  ""y,Error  =  "a"  target-error)) 

) 

(values)) 

; ; ;  eqf 

#+ ; ccl 

(format  t  "*yA"Iet  LearningX"  loaded") 


L 


;  ; ;  Mode:  LISP;  Syntax;  Conmion-lisp;  Package:  *LISP;  Base:  10 
Cin-packago  ’‘lisp) 

: ; ;  Etienne  Deprlt 

;;;  Baval  Research  Lab,  Code  8242 


Tomboulian  Implementation 
OR  Test  lets 


,  lOR  Continuous  Happing  let 

(def-mapping-net  or-mapping-net 

: slabs  ’(21  1  1) 

: input-slab-no  0 
: output-slab-no  2 
: bundles  ’((10  100) 
(2  0  100) 
(2  1  100) 
(1  3  100) 
(2  3  100) 
(3  3  100) 
) 

) 

(defvar  •ior-«apping-pairs») 

(sctf  »ior-mapping-pair8» 
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(list-to-axray-paira  ’(((0.00.0)  (0.0)) 

((0.0  1.0)  (1.0)) 

((1.0  0.0)  (1.0)) 

((1.0  1.0)  (1.0))))) 

(defvar  »ior-iaappiiig-8et») 

(setf  ‘ior-mapping-set* 

(cm-load-mapping-set  ’ ior-mapping-aet  •ior-«apping-paira»)) 

(tr  ain-net  or-mapplng~xi«t 

•ior-aapping-set* 

;  print-traixiing-set  t  ’print-training-set 
:print-int6rtal  10 
:print-net-io  t ’print-io-vecs) 


;  XOR  Associative  Memory  let 


(def-memory-net  or-meaory-net 
: slabs  ’(3  1) 

: input-slab-no  0 
: bundles  ’((00  100) 
(0  1  100) 
(1  1  100) 
) 

;epsilon-s  0.05 

) 


(defvar  ♦xor-memory-list*) 

(setf  ♦xor-memory-list • 

(list-to-array  ’((0.0  0.0  0.0) 
(0.0  1 .0  1.0) 
(1.0  0.0  1.0) 

<1  .0  1 .0  0.0)))) 


(defvar  •xor-meaory-set«) 

(setf  ♦xor-memory-sete 

(ca-load-aeaory-set  ’xor-memory-set  exor-meaory-list*)) 

(train-net  or-aemory-net 

♦xor-memory-set • 

: print -training-set  f ’print-training-set 
:print-lnterval  20 
:print-net-io  • ’pr int-io-vecs) 

; ; .  EOF 
»+;ccl 

(format  t  ""7,\"Teat  lets\"  loaded") 


;;;  Mode:  LISP;  Syntax:  Common-lisp;  Package;  eLISP;  Base:  10 

(in-package  ’elisp) 

; , ;  Et ienne  Deprit 

laval  Research  Lab,  Code  8242 

;;;  Tomboullan  Implementation 

;  Time  lets 
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■,  CM-TIME-IID-PRIIT  time  th*  •zacntion  of  FORM  and  roporta  tha  tiaing  atatiatics. 

(dafaacro  oa-tiaa-and-ptint  (fora) 

(let  ((alapaad-tiaa  (ganaja)) 

(ca-tiaa  (ganaya)) 

(parcant  (ganaya))) 

‘ (auItipla-Talna-bind  (, alapaad-tiaa  , ca-tiaa  .parcant) 

(caitiaa  .fora  :ratnra-atatiatlcB-only-p  t) 

(print-ca-tiaing  ’.(if  (liatp  fora)  (flrat  fora)  fora) 

.alapaad-tiaa 
, ca-tiaa 
.parcant)))) 

:  PRIIT-CM-TIMII6  printa  tha  FE  ELRPSED-TIHF .  CX-TIME  and  CM  naaga  PEXCEIT 
;  statistica  for  tha  giaan  OPERiTIOl. 

(defon  print-ca-tiaing  (oparation  alapaad-tiaa  ca-tiaa  parcant) 

(foraat  t  "'X'a;  '7,3f  aaca  alapaad  tiaa,  ~7 ,3t  aaca  CM  tiaa  Cd.lrt)" 
oparation  alapaad-tiaa  ca-tiaa  parcant)) 


Happing  Rat  Tiainga 


;  TIHE-MIPPIIG-IET  coapilaa  tiaing  atatiatlca  for  tha  COITIIUOUS-MIPPIIG  test  nat 
;  up  to  MIX-I.  IICREMEIT  controla  grannlarity  of  tha  incraaant  in  net  size. 

(defun  tiae-aapplng-nat  (aaz-n  they  (increaent  D) 

(cai: ;calibrata-ca-tiaer) 

(let  (aapping-net 
aapping-sat) 

(do  ((n  1  (a  increaent  n))) 

((>  n  aaz-n)) 

(satf  aapplng-nat 

(fa-aaka-nat  ’aapplng-nat 

: continoous-aapping 
(liat  (a  4  n)  (*  7  n)  n  1) 

0 

3 

’((1  0  1(X)) 

(3  0  100) 

(3  1  100) 

(1  3  100) 

(3  3  100) 

(3  3  100) 

) 

)) 

(fozaat  t  "'3%*aa  i  «  *a  •••"  n) 

(foraat  t  "'XHapping  not:  'a  units,  *a  connections  ->  'a  procassors” 
(nat-no-units  aapping-not) 

(not-no-connactions  aapping-nat) 

(nat-no-procassors  aapping-nat)) 

(ca-nat-cold-boot  aapping-nat) 

(foraat  t  ’'*XVP  ratio  ■  "a"  cB.-arirtual-to-physical-procassor-ratio*) 
(ca-tiaa-and -print 

(cB-aaka-nat  aapping-nat)) 

(foraat  t  '''XlUocation  aoda  'a'*  (nat-allocation-aoda  aapping-nat)) 

(foraat  t  "'XTiaa  quantna  >  *a"  atiaa-quantna*) 

(foraat  t  "'IRonting  tablo  naaga  •  ‘6,3fX''  (eall  (graph-slots-nsaga))) 

(aotf  aapping-sat 

(ca-load-aapping-sat  ’aapping-sat 
(list 

(list  (aaka-array  (a  4  n)  : initial-alaaant  1.0) 
(aaka-array  n  ; initial-alaaant  1.0))))) 

(ca-t iaa-and-print 
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(feed-f orvard  napping-net 

(exanqplar-input-pvar  (get-exanplar  mapping-set  0)))) 

(cm-t ime-and-print 

(back-propagate  mapping-net 

(ezamplar-target-pvar  (get-exaBq>lar  mapping-set  0)))) 

(if  (and  (=  n  1)  (/=  increment  1))  (decf  n)) 

))) 

;  TIHE-MEMORY-IET  compiles  timing  statistics  for  the  ASSOCIATIVE-MEMORY  test  net 
;  up  to  MAX-1.  I8CREMEVT  controls  granularity  of  the  increment  in  net  size. 

(defun  time-memory-net  (max-n  they  (increment  D) 

(cmi: : calibrate-cm-timer) 

(let  (memory-net 
memory-set) 

(do  ((n  I  (+  increment  n))) 

( (>  n  max-n) ) 

(setf  memory-net 

(f e-maike-net  ’memory-net 

: associat ive-memory 
(list  (•  8  n)  n) 

0 

0 

’((1  0  25) 

(0  1  25) 

) 

)) 

(format  t  ""S*/,***  I  =  "a  n) 

(  -irnat  t  "“VJIemory  net:  'a  units,  "a  connections  ->  "a  processors" 

(net-no-units  memory-net) 

(net-no-connections  memory-net) 

(net-no-processors  memory-net)) 

(cm-net-cold-boot  memory-net) 

(format  t  "'*/.VP  ratio  =  'a"  cra:*virtual-to-physical-processor-ratio*) 

(cm-t ime-and-print 

(cm-maJce-net  memory-net)) 

(format  t  "^y.Allocation  mode  'a‘‘  (net -allocation-mode  memory-net)) 

(format  t  "'yiime  quantum  *  *a"  etime-quantum*) 

(format  t  "'^Routing  table  usage  »  *6,3f)l‘*  (eall  (graph-slots-usage))) 

(setf  memory-set 

(cm-load -memory-set  ’memory -set 

(list  (make-array  (*  8  n)  : initial-element  1.0)))) 

(cm-t ime-and-print 

(feed-forward  memory-net  (examplar-input-pvar  (get-examplar  memory-set  0)))) 
(cm-t  ime-and-print 

(back-propagate  memory-net  ( exemplar- input-pwar  (get-examplar  memory-set  0)))) 

(if  (and  (=  n  1)  (/=  increment  1))  (decf  n)) 

))) 

, . i  EOF 
#+:ccl 

(format  t  "*y.\‘‘Tinie  letsN"  loaded") 
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